{-# 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.GetBackupPlan
-- 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 @BackupPlan@ details for the specified @BackupPlanId@. The
-- details are the body of a backup plan in JSON format, in addition to
-- plan metadata.
module Amazonka.Backup.GetBackupPlan
  ( -- * Creating a Request
    GetBackupPlan (..),
    newGetBackupPlan,

    -- * Request Lenses
    getBackupPlan_versionId,
    getBackupPlan_backupPlanId,

    -- * Destructuring the Response
    GetBackupPlanResponse (..),
    newGetBackupPlanResponse,

    -- * Response Lenses
    getBackupPlanResponse_advancedBackupSettings,
    getBackupPlanResponse_backupPlan,
    getBackupPlanResponse_backupPlanArn,
    getBackupPlanResponse_backupPlanId,
    getBackupPlanResponse_creationDate,
    getBackupPlanResponse_creatorRequestId,
    getBackupPlanResponse_deletionDate,
    getBackupPlanResponse_lastExecutionDate,
    getBackupPlanResponse_versionId,
    getBackupPlanResponse_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:/ 'newGetBackupPlan' smart constructor.
data GetBackupPlan = GetBackupPlan'
  { -- | Unique, randomly generated, Unicode, UTF-8 encoded strings that are at
    -- most 1,024 bytes long. Version IDs cannot be edited.
    GetBackupPlan -> Maybe Text
versionId :: Prelude.Maybe Prelude.Text,
    -- | Uniquely identifies a backup plan.
    GetBackupPlan -> Text
backupPlanId :: Prelude.Text
  }
  deriving (GetBackupPlan -> GetBackupPlan -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBackupPlan -> GetBackupPlan -> Bool
$c/= :: GetBackupPlan -> GetBackupPlan -> Bool
== :: GetBackupPlan -> GetBackupPlan -> Bool
$c== :: GetBackupPlan -> GetBackupPlan -> Bool
Prelude.Eq, ReadPrec [GetBackupPlan]
ReadPrec GetBackupPlan
Int -> ReadS GetBackupPlan
ReadS [GetBackupPlan]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetBackupPlan]
$creadListPrec :: ReadPrec [GetBackupPlan]
readPrec :: ReadPrec GetBackupPlan
$creadPrec :: ReadPrec GetBackupPlan
readList :: ReadS [GetBackupPlan]
$creadList :: ReadS [GetBackupPlan]
readsPrec :: Int -> ReadS GetBackupPlan
$creadsPrec :: Int -> ReadS GetBackupPlan
Prelude.Read, Int -> GetBackupPlan -> ShowS
[GetBackupPlan] -> ShowS
GetBackupPlan -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBackupPlan] -> ShowS
$cshowList :: [GetBackupPlan] -> ShowS
show :: GetBackupPlan -> String
$cshow :: GetBackupPlan -> String
showsPrec :: Int -> GetBackupPlan -> ShowS
$cshowsPrec :: Int -> GetBackupPlan -> ShowS
Prelude.Show, forall x. Rep GetBackupPlan x -> GetBackupPlan
forall x. GetBackupPlan -> Rep GetBackupPlan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetBackupPlan x -> GetBackupPlan
$cfrom :: forall x. GetBackupPlan -> Rep GetBackupPlan x
Prelude.Generic)

-- |
-- Create a value of 'GetBackupPlan' 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:
--
-- 'versionId', 'getBackupPlan_versionId' - Unique, randomly generated, Unicode, UTF-8 encoded strings that are at
-- most 1,024 bytes long. Version IDs cannot be edited.
--
-- 'backupPlanId', 'getBackupPlan_backupPlanId' - Uniquely identifies a backup plan.
newGetBackupPlan ::
  -- | 'backupPlanId'
  Prelude.Text ->
  GetBackupPlan
newGetBackupPlan :: Text -> GetBackupPlan
newGetBackupPlan Text
pBackupPlanId_ =
  GetBackupPlan'
    { $sel:versionId:GetBackupPlan' :: Maybe Text
versionId = forall a. Maybe a
Prelude.Nothing,
      $sel:backupPlanId:GetBackupPlan' :: Text
backupPlanId = Text
pBackupPlanId_
    }

-- | Unique, randomly generated, Unicode, UTF-8 encoded strings that are at
-- most 1,024 bytes long. Version IDs cannot be edited.
getBackupPlan_versionId :: Lens.Lens' GetBackupPlan (Prelude.Maybe Prelude.Text)
getBackupPlan_versionId :: Lens' GetBackupPlan (Maybe Text)
getBackupPlan_versionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBackupPlan' {Maybe Text
versionId :: Maybe Text
$sel:versionId:GetBackupPlan' :: GetBackupPlan -> Maybe Text
versionId} -> Maybe Text
versionId) (\s :: GetBackupPlan
s@GetBackupPlan' {} Maybe Text
a -> GetBackupPlan
s {$sel:versionId:GetBackupPlan' :: Maybe Text
versionId = Maybe Text
a} :: GetBackupPlan)

-- | Uniquely identifies a backup plan.
getBackupPlan_backupPlanId :: Lens.Lens' GetBackupPlan Prelude.Text
getBackupPlan_backupPlanId :: Lens' GetBackupPlan Text
getBackupPlan_backupPlanId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBackupPlan' {Text
backupPlanId :: Text
$sel:backupPlanId:GetBackupPlan' :: GetBackupPlan -> Text
backupPlanId} -> Text
backupPlanId) (\s :: GetBackupPlan
s@GetBackupPlan' {} Text
a -> GetBackupPlan
s {$sel:backupPlanId:GetBackupPlan' :: Text
backupPlanId = Text
a} :: GetBackupPlan)

instance Core.AWSRequest GetBackupPlan where
  type
    AWSResponse GetBackupPlan =
      GetBackupPlanResponse
  request :: (Service -> Service) -> GetBackupPlan -> Request GetBackupPlan
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 GetBackupPlan
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetBackupPlan)))
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 [AdvancedBackupSetting]
-> Maybe BackupPlan
-> Maybe Text
-> Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe POSIX
-> Maybe POSIX
-> Maybe Text
-> Int
-> GetBackupPlanResponse
GetBackupPlanResponse'
            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
"AdvancedBackupSettings"
                            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
"BackupPlan")
            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
"BackupPlanArn")
            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
"BackupPlanId")
            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
"CreatorRequestId")
            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
"DeletionDate")
            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
"LastExecutionDate")
            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
"VersionId")
            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 GetBackupPlan where
  hashWithSalt :: Int -> GetBackupPlan -> Int
hashWithSalt Int
_salt GetBackupPlan' {Maybe Text
Text
backupPlanId :: Text
versionId :: Maybe Text
$sel:backupPlanId:GetBackupPlan' :: GetBackupPlan -> Text
$sel:versionId:GetBackupPlan' :: GetBackupPlan -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
versionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
backupPlanId

instance Prelude.NFData GetBackupPlan where
  rnf :: GetBackupPlan -> ()
rnf GetBackupPlan' {Maybe Text
Text
backupPlanId :: Text
versionId :: Maybe Text
$sel:backupPlanId:GetBackupPlan' :: GetBackupPlan -> Text
$sel:versionId:GetBackupPlan' :: GetBackupPlan -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
versionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
backupPlanId

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

instance Data.ToQuery GetBackupPlan where
  toQuery :: GetBackupPlan -> QueryString
toQuery GetBackupPlan' {Maybe Text
Text
backupPlanId :: Text
versionId :: Maybe Text
$sel:backupPlanId:GetBackupPlan' :: GetBackupPlan -> Text
$sel:versionId:GetBackupPlan' :: GetBackupPlan -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"versionId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
versionId]

-- | /See:/ 'newGetBackupPlanResponse' smart constructor.
data GetBackupPlanResponse = GetBackupPlanResponse'
  { -- | Contains a list of @BackupOptions@ for each resource type. The list is
    -- populated only if the advanced option is set for the backup plan.
    GetBackupPlanResponse -> Maybe [AdvancedBackupSetting]
advancedBackupSettings :: Prelude.Maybe [AdvancedBackupSetting],
    -- | Specifies the body of a backup plan. Includes a @BackupPlanName@ and one
    -- or more sets of @Rules@.
    GetBackupPlanResponse -> Maybe BackupPlan
backupPlan :: Prelude.Maybe BackupPlan,
    -- | An Amazon Resource Name (ARN) that uniquely identifies a backup plan;
    -- for example,
    -- @arn:aws:backup:us-east-1:123456789012:plan:8F81F553-3A74-4A3F-B93D-B3360DC80C50@.
    GetBackupPlanResponse -> Maybe Text
backupPlanArn :: Prelude.Maybe Prelude.Text,
    -- | Uniquely identifies a backup plan.
    GetBackupPlanResponse -> Maybe Text
backupPlanId :: Prelude.Maybe Prelude.Text,
    -- | The date and time that a backup plan 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.
    GetBackupPlanResponse -> Maybe POSIX
creationDate :: Prelude.Maybe Data.POSIX,
    -- | A unique string that identifies the request and allows failed requests
    -- to be retried without the risk of running the operation twice.
    GetBackupPlanResponse -> Maybe Text
creatorRequestId :: Prelude.Maybe Prelude.Text,
    -- | The date and time that a backup plan is deleted, in Unix format and
    -- Coordinated Universal Time (UTC). The value of @DeletionDate@ is
    -- accurate to milliseconds. For example, the value 1516925490.087
    -- represents Friday, January 26, 2018 12:11:30.087 AM.
    GetBackupPlanResponse -> Maybe POSIX
deletionDate :: Prelude.Maybe Data.POSIX,
    -- | The last time a job to back up resources was run with this backup plan.
    -- A date and time, in Unix format and Coordinated Universal Time (UTC).
    -- The value of @LastExecutionDate@ is accurate to milliseconds. For
    -- example, the value 1516925490.087 represents Friday, January 26, 2018
    -- 12:11:30.087 AM.
    GetBackupPlanResponse -> Maybe POSIX
lastExecutionDate :: Prelude.Maybe Data.POSIX,
    -- | Unique, randomly generated, Unicode, UTF-8 encoded strings that are at
    -- most 1,024 bytes long. Version IDs cannot be edited.
    GetBackupPlanResponse -> Maybe Text
versionId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetBackupPlanResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetBackupPlanResponse -> GetBackupPlanResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetBackupPlanResponse -> GetBackupPlanResponse -> Bool
$c/= :: GetBackupPlanResponse -> GetBackupPlanResponse -> Bool
== :: GetBackupPlanResponse -> GetBackupPlanResponse -> Bool
$c== :: GetBackupPlanResponse -> GetBackupPlanResponse -> Bool
Prelude.Eq, Int -> GetBackupPlanResponse -> ShowS
[GetBackupPlanResponse] -> ShowS
GetBackupPlanResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetBackupPlanResponse] -> ShowS
$cshowList :: [GetBackupPlanResponse] -> ShowS
show :: GetBackupPlanResponse -> String
$cshow :: GetBackupPlanResponse -> String
showsPrec :: Int -> GetBackupPlanResponse -> ShowS
$cshowsPrec :: Int -> GetBackupPlanResponse -> ShowS
Prelude.Show, forall x. Rep GetBackupPlanResponse x -> GetBackupPlanResponse
forall x. GetBackupPlanResponse -> Rep GetBackupPlanResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetBackupPlanResponse x -> GetBackupPlanResponse
$cfrom :: forall x. GetBackupPlanResponse -> Rep GetBackupPlanResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetBackupPlanResponse' 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:
--
-- 'advancedBackupSettings', 'getBackupPlanResponse_advancedBackupSettings' - Contains a list of @BackupOptions@ for each resource type. The list is
-- populated only if the advanced option is set for the backup plan.
--
-- 'backupPlan', 'getBackupPlanResponse_backupPlan' - Specifies the body of a backup plan. Includes a @BackupPlanName@ and one
-- or more sets of @Rules@.
--
-- 'backupPlanArn', 'getBackupPlanResponse_backupPlanArn' - An Amazon Resource Name (ARN) that uniquely identifies a backup plan;
-- for example,
-- @arn:aws:backup:us-east-1:123456789012:plan:8F81F553-3A74-4A3F-B93D-B3360DC80C50@.
--
-- 'backupPlanId', 'getBackupPlanResponse_backupPlanId' - Uniquely identifies a backup plan.
--
-- 'creationDate', 'getBackupPlanResponse_creationDate' - The date and time that a backup plan 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.
--
-- 'creatorRequestId', 'getBackupPlanResponse_creatorRequestId' - A unique string that identifies the request and allows failed requests
-- to be retried without the risk of running the operation twice.
--
-- 'deletionDate', 'getBackupPlanResponse_deletionDate' - The date and time that a backup plan is deleted, in Unix format and
-- Coordinated Universal Time (UTC). The value of @DeletionDate@ is
-- accurate to milliseconds. For example, the value 1516925490.087
-- represents Friday, January 26, 2018 12:11:30.087 AM.
--
-- 'lastExecutionDate', 'getBackupPlanResponse_lastExecutionDate' - The last time a job to back up resources was run with this backup plan.
-- A date and time, in Unix format and Coordinated Universal Time (UTC).
-- The value of @LastExecutionDate@ is accurate to milliseconds. For
-- example, the value 1516925490.087 represents Friday, January 26, 2018
-- 12:11:30.087 AM.
--
-- 'versionId', 'getBackupPlanResponse_versionId' - Unique, randomly generated, Unicode, UTF-8 encoded strings that are at
-- most 1,024 bytes long. Version IDs cannot be edited.
--
-- 'httpStatus', 'getBackupPlanResponse_httpStatus' - The response's http status code.
newGetBackupPlanResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetBackupPlanResponse
newGetBackupPlanResponse :: Int -> GetBackupPlanResponse
newGetBackupPlanResponse Int
pHttpStatus_ =
  GetBackupPlanResponse'
    { $sel:advancedBackupSettings:GetBackupPlanResponse' :: Maybe [AdvancedBackupSetting]
advancedBackupSettings =
        forall a. Maybe a
Prelude.Nothing,
      $sel:backupPlan:GetBackupPlanResponse' :: Maybe BackupPlan
backupPlan = forall a. Maybe a
Prelude.Nothing,
      $sel:backupPlanArn:GetBackupPlanResponse' :: Maybe Text
backupPlanArn = forall a. Maybe a
Prelude.Nothing,
      $sel:backupPlanId:GetBackupPlanResponse' :: Maybe Text
backupPlanId = forall a. Maybe a
Prelude.Nothing,
      $sel:creationDate:GetBackupPlanResponse' :: Maybe POSIX
creationDate = forall a. Maybe a
Prelude.Nothing,
      $sel:creatorRequestId:GetBackupPlanResponse' :: Maybe Text
creatorRequestId = forall a. Maybe a
Prelude.Nothing,
      $sel:deletionDate:GetBackupPlanResponse' :: Maybe POSIX
deletionDate = forall a. Maybe a
Prelude.Nothing,
      $sel:lastExecutionDate:GetBackupPlanResponse' :: Maybe POSIX
lastExecutionDate = forall a. Maybe a
Prelude.Nothing,
      $sel:versionId:GetBackupPlanResponse' :: Maybe Text
versionId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetBackupPlanResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Contains a list of @BackupOptions@ for each resource type. The list is
-- populated only if the advanced option is set for the backup plan.
getBackupPlanResponse_advancedBackupSettings :: Lens.Lens' GetBackupPlanResponse (Prelude.Maybe [AdvancedBackupSetting])
getBackupPlanResponse_advancedBackupSettings :: Lens' GetBackupPlanResponse (Maybe [AdvancedBackupSetting])
getBackupPlanResponse_advancedBackupSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBackupPlanResponse' {Maybe [AdvancedBackupSetting]
advancedBackupSettings :: Maybe [AdvancedBackupSetting]
$sel:advancedBackupSettings:GetBackupPlanResponse' :: GetBackupPlanResponse -> Maybe [AdvancedBackupSetting]
advancedBackupSettings} -> Maybe [AdvancedBackupSetting]
advancedBackupSettings) (\s :: GetBackupPlanResponse
s@GetBackupPlanResponse' {} Maybe [AdvancedBackupSetting]
a -> GetBackupPlanResponse
s {$sel:advancedBackupSettings:GetBackupPlanResponse' :: Maybe [AdvancedBackupSetting]
advancedBackupSettings = Maybe [AdvancedBackupSetting]
a} :: GetBackupPlanResponse) 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

-- | Specifies the body of a backup plan. Includes a @BackupPlanName@ and one
-- or more sets of @Rules@.
getBackupPlanResponse_backupPlan :: Lens.Lens' GetBackupPlanResponse (Prelude.Maybe BackupPlan)
getBackupPlanResponse_backupPlan :: Lens' GetBackupPlanResponse (Maybe BackupPlan)
getBackupPlanResponse_backupPlan = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBackupPlanResponse' {Maybe BackupPlan
backupPlan :: Maybe BackupPlan
$sel:backupPlan:GetBackupPlanResponse' :: GetBackupPlanResponse -> Maybe BackupPlan
backupPlan} -> Maybe BackupPlan
backupPlan) (\s :: GetBackupPlanResponse
s@GetBackupPlanResponse' {} Maybe BackupPlan
a -> GetBackupPlanResponse
s {$sel:backupPlan:GetBackupPlanResponse' :: Maybe BackupPlan
backupPlan = Maybe BackupPlan
a} :: GetBackupPlanResponse)

-- | An Amazon Resource Name (ARN) that uniquely identifies a backup plan;
-- for example,
-- @arn:aws:backup:us-east-1:123456789012:plan:8F81F553-3A74-4A3F-B93D-B3360DC80C50@.
getBackupPlanResponse_backupPlanArn :: Lens.Lens' GetBackupPlanResponse (Prelude.Maybe Prelude.Text)
getBackupPlanResponse_backupPlanArn :: Lens' GetBackupPlanResponse (Maybe Text)
getBackupPlanResponse_backupPlanArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBackupPlanResponse' {Maybe Text
backupPlanArn :: Maybe Text
$sel:backupPlanArn:GetBackupPlanResponse' :: GetBackupPlanResponse -> Maybe Text
backupPlanArn} -> Maybe Text
backupPlanArn) (\s :: GetBackupPlanResponse
s@GetBackupPlanResponse' {} Maybe Text
a -> GetBackupPlanResponse
s {$sel:backupPlanArn:GetBackupPlanResponse' :: Maybe Text
backupPlanArn = Maybe Text
a} :: GetBackupPlanResponse)

-- | Uniquely identifies a backup plan.
getBackupPlanResponse_backupPlanId :: Lens.Lens' GetBackupPlanResponse (Prelude.Maybe Prelude.Text)
getBackupPlanResponse_backupPlanId :: Lens' GetBackupPlanResponse (Maybe Text)
getBackupPlanResponse_backupPlanId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBackupPlanResponse' {Maybe Text
backupPlanId :: Maybe Text
$sel:backupPlanId:GetBackupPlanResponse' :: GetBackupPlanResponse -> Maybe Text
backupPlanId} -> Maybe Text
backupPlanId) (\s :: GetBackupPlanResponse
s@GetBackupPlanResponse' {} Maybe Text
a -> GetBackupPlanResponse
s {$sel:backupPlanId:GetBackupPlanResponse' :: Maybe Text
backupPlanId = Maybe Text
a} :: GetBackupPlanResponse)

-- | The date and time that a backup plan 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.
getBackupPlanResponse_creationDate :: Lens.Lens' GetBackupPlanResponse (Prelude.Maybe Prelude.UTCTime)
getBackupPlanResponse_creationDate :: Lens' GetBackupPlanResponse (Maybe UTCTime)
getBackupPlanResponse_creationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBackupPlanResponse' {Maybe POSIX
creationDate :: Maybe POSIX
$sel:creationDate:GetBackupPlanResponse' :: GetBackupPlanResponse -> Maybe POSIX
creationDate} -> Maybe POSIX
creationDate) (\s :: GetBackupPlanResponse
s@GetBackupPlanResponse' {} Maybe POSIX
a -> GetBackupPlanResponse
s {$sel:creationDate:GetBackupPlanResponse' :: Maybe POSIX
creationDate = Maybe POSIX
a} :: GetBackupPlanResponse) 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

-- | A unique string that identifies the request and allows failed requests
-- to be retried without the risk of running the operation twice.
getBackupPlanResponse_creatorRequestId :: Lens.Lens' GetBackupPlanResponse (Prelude.Maybe Prelude.Text)
getBackupPlanResponse_creatorRequestId :: Lens' GetBackupPlanResponse (Maybe Text)
getBackupPlanResponse_creatorRequestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBackupPlanResponse' {Maybe Text
creatorRequestId :: Maybe Text
$sel:creatorRequestId:GetBackupPlanResponse' :: GetBackupPlanResponse -> Maybe Text
creatorRequestId} -> Maybe Text
creatorRequestId) (\s :: GetBackupPlanResponse
s@GetBackupPlanResponse' {} Maybe Text
a -> GetBackupPlanResponse
s {$sel:creatorRequestId:GetBackupPlanResponse' :: Maybe Text
creatorRequestId = Maybe Text
a} :: GetBackupPlanResponse)

-- | The date and time that a backup plan is deleted, in Unix format and
-- Coordinated Universal Time (UTC). The value of @DeletionDate@ is
-- accurate to milliseconds. For example, the value 1516925490.087
-- represents Friday, January 26, 2018 12:11:30.087 AM.
getBackupPlanResponse_deletionDate :: Lens.Lens' GetBackupPlanResponse (Prelude.Maybe Prelude.UTCTime)
getBackupPlanResponse_deletionDate :: Lens' GetBackupPlanResponse (Maybe UTCTime)
getBackupPlanResponse_deletionDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBackupPlanResponse' {Maybe POSIX
deletionDate :: Maybe POSIX
$sel:deletionDate:GetBackupPlanResponse' :: GetBackupPlanResponse -> Maybe POSIX
deletionDate} -> Maybe POSIX
deletionDate) (\s :: GetBackupPlanResponse
s@GetBackupPlanResponse' {} Maybe POSIX
a -> GetBackupPlanResponse
s {$sel:deletionDate:GetBackupPlanResponse' :: Maybe POSIX
deletionDate = Maybe POSIX
a} :: GetBackupPlanResponse) 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 last time a job to back up resources was run with this backup plan.
-- A date and time, in Unix format and Coordinated Universal Time (UTC).
-- The value of @LastExecutionDate@ is accurate to milliseconds. For
-- example, the value 1516925490.087 represents Friday, January 26, 2018
-- 12:11:30.087 AM.
getBackupPlanResponse_lastExecutionDate :: Lens.Lens' GetBackupPlanResponse (Prelude.Maybe Prelude.UTCTime)
getBackupPlanResponse_lastExecutionDate :: Lens' GetBackupPlanResponse (Maybe UTCTime)
getBackupPlanResponse_lastExecutionDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBackupPlanResponse' {Maybe POSIX
lastExecutionDate :: Maybe POSIX
$sel:lastExecutionDate:GetBackupPlanResponse' :: GetBackupPlanResponse -> Maybe POSIX
lastExecutionDate} -> Maybe POSIX
lastExecutionDate) (\s :: GetBackupPlanResponse
s@GetBackupPlanResponse' {} Maybe POSIX
a -> GetBackupPlanResponse
s {$sel:lastExecutionDate:GetBackupPlanResponse' :: Maybe POSIX
lastExecutionDate = Maybe POSIX
a} :: GetBackupPlanResponse) 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

-- | Unique, randomly generated, Unicode, UTF-8 encoded strings that are at
-- most 1,024 bytes long. Version IDs cannot be edited.
getBackupPlanResponse_versionId :: Lens.Lens' GetBackupPlanResponse (Prelude.Maybe Prelude.Text)
getBackupPlanResponse_versionId :: Lens' GetBackupPlanResponse (Maybe Text)
getBackupPlanResponse_versionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetBackupPlanResponse' {Maybe Text
versionId :: Maybe Text
$sel:versionId:GetBackupPlanResponse' :: GetBackupPlanResponse -> Maybe Text
versionId} -> Maybe Text
versionId) (\s :: GetBackupPlanResponse
s@GetBackupPlanResponse' {} Maybe Text
a -> GetBackupPlanResponse
s {$sel:versionId:GetBackupPlanResponse' :: Maybe Text
versionId = Maybe Text
a} :: GetBackupPlanResponse)

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

instance Prelude.NFData GetBackupPlanResponse where
  rnf :: GetBackupPlanResponse -> ()
rnf GetBackupPlanResponse' {Int
Maybe [AdvancedBackupSetting]
Maybe Text
Maybe POSIX
Maybe BackupPlan
httpStatus :: Int
versionId :: Maybe Text
lastExecutionDate :: Maybe POSIX
deletionDate :: Maybe POSIX
creatorRequestId :: Maybe Text
creationDate :: Maybe POSIX
backupPlanId :: Maybe Text
backupPlanArn :: Maybe Text
backupPlan :: Maybe BackupPlan
advancedBackupSettings :: Maybe [AdvancedBackupSetting]
$sel:httpStatus:GetBackupPlanResponse' :: GetBackupPlanResponse -> Int
$sel:versionId:GetBackupPlanResponse' :: GetBackupPlanResponse -> Maybe Text
$sel:lastExecutionDate:GetBackupPlanResponse' :: GetBackupPlanResponse -> Maybe POSIX
$sel:deletionDate:GetBackupPlanResponse' :: GetBackupPlanResponse -> Maybe POSIX
$sel:creatorRequestId:GetBackupPlanResponse' :: GetBackupPlanResponse -> Maybe Text
$sel:creationDate:GetBackupPlanResponse' :: GetBackupPlanResponse -> Maybe POSIX
$sel:backupPlanId:GetBackupPlanResponse' :: GetBackupPlanResponse -> Maybe Text
$sel:backupPlanArn:GetBackupPlanResponse' :: GetBackupPlanResponse -> Maybe Text
$sel:backupPlan:GetBackupPlanResponse' :: GetBackupPlanResponse -> Maybe BackupPlan
$sel:advancedBackupSettings:GetBackupPlanResponse' :: GetBackupPlanResponse -> Maybe [AdvancedBackupSetting]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [AdvancedBackupSetting]
advancedBackupSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BackupPlan
backupPlan
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
backupPlanArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
backupPlanId
      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
creatorRequestId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
deletionDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastExecutionDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
versionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus