{-# 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.CreateBackupPlan
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a backup plan using a backup plan name and backup rules. A
-- backup plan is a document that contains information that Backup uses to
-- schedule tasks that create recovery points for resources.
--
-- If you call @CreateBackupPlan@ with a plan that already exists, you
-- receive an @AlreadyExistsException@ exception.
module Amazonka.Backup.CreateBackupPlan
  ( -- * Creating a Request
    CreateBackupPlan (..),
    newCreateBackupPlan,

    -- * Request Lenses
    createBackupPlan_backupPlanTags,
    createBackupPlan_creatorRequestId,
    createBackupPlan_backupPlan,

    -- * Destructuring the Response
    CreateBackupPlanResponse (..),
    newCreateBackupPlanResponse,

    -- * Response Lenses
    createBackupPlanResponse_advancedBackupSettings,
    createBackupPlanResponse_backupPlanArn,
    createBackupPlanResponse_backupPlanId,
    createBackupPlanResponse_creationDate,
    createBackupPlanResponse_versionId,
    createBackupPlanResponse_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:/ 'newCreateBackupPlan' smart constructor.
data CreateBackupPlan = CreateBackupPlan'
  { -- | To help organize your resources, you can assign your own metadata to the
    -- resources that you create. Each tag is a key-value pair. The specified
    -- tags are assigned to all backups created with this plan.
    CreateBackupPlan -> Maybe (Sensitive (HashMap Text Text))
backupPlanTags :: Prelude.Maybe (Data.Sensitive (Prelude.HashMap Prelude.Text Prelude.Text)),
    -- | Identifies the request and allows failed requests to be retried without
    -- the risk of running the operation twice. If the request includes a
    -- @CreatorRequestId@ that matches an existing backup plan, that plan is
    -- returned. This parameter is optional.
    --
    -- If used, this parameter must contain 1 to 50 alphanumeric or \'-_.\'
    -- characters.
    CreateBackupPlan -> Maybe Text
creatorRequestId :: Prelude.Maybe Prelude.Text,
    -- | Specifies the body of a backup plan. Includes a @BackupPlanName@ and one
    -- or more sets of @Rules@.
    CreateBackupPlan -> BackupPlanInput
backupPlan :: BackupPlanInput
  }
  deriving (CreateBackupPlan -> CreateBackupPlan -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateBackupPlan -> CreateBackupPlan -> Bool
$c/= :: CreateBackupPlan -> CreateBackupPlan -> Bool
== :: CreateBackupPlan -> CreateBackupPlan -> Bool
$c== :: CreateBackupPlan -> CreateBackupPlan -> Bool
Prelude.Eq, Int -> CreateBackupPlan -> ShowS
[CreateBackupPlan] -> ShowS
CreateBackupPlan -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateBackupPlan] -> ShowS
$cshowList :: [CreateBackupPlan] -> ShowS
show :: CreateBackupPlan -> String
$cshow :: CreateBackupPlan -> String
showsPrec :: Int -> CreateBackupPlan -> ShowS
$cshowsPrec :: Int -> CreateBackupPlan -> ShowS
Prelude.Show, forall x. Rep CreateBackupPlan x -> CreateBackupPlan
forall x. CreateBackupPlan -> Rep CreateBackupPlan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateBackupPlan x -> CreateBackupPlan
$cfrom :: forall x. CreateBackupPlan -> Rep CreateBackupPlan x
Prelude.Generic)

-- |
-- Create a value of 'CreateBackupPlan' 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:
--
-- 'backupPlanTags', 'createBackupPlan_backupPlanTags' - To help organize your resources, you can assign your own metadata to the
-- resources that you create. Each tag is a key-value pair. The specified
-- tags are assigned to all backups created with this plan.
--
-- 'creatorRequestId', 'createBackupPlan_creatorRequestId' - Identifies the request and allows failed requests to be retried without
-- the risk of running the operation twice. If the request includes a
-- @CreatorRequestId@ that matches an existing backup plan, that plan is
-- returned. This parameter is optional.
--
-- If used, this parameter must contain 1 to 50 alphanumeric or \'-_.\'
-- characters.
--
-- 'backupPlan', 'createBackupPlan_backupPlan' - Specifies the body of a backup plan. Includes a @BackupPlanName@ and one
-- or more sets of @Rules@.
newCreateBackupPlan ::
  -- | 'backupPlan'
  BackupPlanInput ->
  CreateBackupPlan
newCreateBackupPlan :: BackupPlanInput -> CreateBackupPlan
newCreateBackupPlan BackupPlanInput
pBackupPlan_ =
  CreateBackupPlan'
    { $sel:backupPlanTags:CreateBackupPlan' :: Maybe (Sensitive (HashMap Text Text))
backupPlanTags = forall a. Maybe a
Prelude.Nothing,
      $sel:creatorRequestId:CreateBackupPlan' :: Maybe Text
creatorRequestId = forall a. Maybe a
Prelude.Nothing,
      $sel:backupPlan:CreateBackupPlan' :: BackupPlanInput
backupPlan = BackupPlanInput
pBackupPlan_
    }

-- | To help organize your resources, you can assign your own metadata to the
-- resources that you create. Each tag is a key-value pair. The specified
-- tags are assigned to all backups created with this plan.
createBackupPlan_backupPlanTags :: Lens.Lens' CreateBackupPlan (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createBackupPlan_backupPlanTags :: Lens' CreateBackupPlan (Maybe (HashMap Text Text))
createBackupPlan_backupPlanTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBackupPlan' {Maybe (Sensitive (HashMap Text Text))
backupPlanTags :: Maybe (Sensitive (HashMap Text Text))
$sel:backupPlanTags:CreateBackupPlan' :: CreateBackupPlan -> Maybe (Sensitive (HashMap Text Text))
backupPlanTags} -> Maybe (Sensitive (HashMap Text Text))
backupPlanTags) (\s :: CreateBackupPlan
s@CreateBackupPlan' {} Maybe (Sensitive (HashMap Text Text))
a -> CreateBackupPlan
s {$sel:backupPlanTags:CreateBackupPlan' :: Maybe (Sensitive (HashMap Text Text))
backupPlanTags = Maybe (Sensitive (HashMap Text Text))
a} :: CreateBackupPlan) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping (forall a. Iso' (Sensitive a) a
Data._Sensitive forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced)

-- | Identifies the request and allows failed requests to be retried without
-- the risk of running the operation twice. If the request includes a
-- @CreatorRequestId@ that matches an existing backup plan, that plan is
-- returned. This parameter is optional.
--
-- If used, this parameter must contain 1 to 50 alphanumeric or \'-_.\'
-- characters.
createBackupPlan_creatorRequestId :: Lens.Lens' CreateBackupPlan (Prelude.Maybe Prelude.Text)
createBackupPlan_creatorRequestId :: Lens' CreateBackupPlan (Maybe Text)
createBackupPlan_creatorRequestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBackupPlan' {Maybe Text
creatorRequestId :: Maybe Text
$sel:creatorRequestId:CreateBackupPlan' :: CreateBackupPlan -> Maybe Text
creatorRequestId} -> Maybe Text
creatorRequestId) (\s :: CreateBackupPlan
s@CreateBackupPlan' {} Maybe Text
a -> CreateBackupPlan
s {$sel:creatorRequestId:CreateBackupPlan' :: Maybe Text
creatorRequestId = Maybe Text
a} :: CreateBackupPlan)

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

instance Core.AWSRequest CreateBackupPlan where
  type
    AWSResponse CreateBackupPlan =
      CreateBackupPlanResponse
  request :: (Service -> Service)
-> CreateBackupPlan -> Request CreateBackupPlan
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateBackupPlan
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateBackupPlan)))
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 Text
-> Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Int
-> CreateBackupPlanResponse
CreateBackupPlanResponse'
            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
"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
"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 CreateBackupPlan where
  hashWithSalt :: Int -> CreateBackupPlan -> Int
hashWithSalt Int
_salt CreateBackupPlan' {Maybe Text
Maybe (Sensitive (HashMap Text Text))
BackupPlanInput
backupPlan :: BackupPlanInput
creatorRequestId :: Maybe Text
backupPlanTags :: Maybe (Sensitive (HashMap Text Text))
$sel:backupPlan:CreateBackupPlan' :: CreateBackupPlan -> BackupPlanInput
$sel:creatorRequestId:CreateBackupPlan' :: CreateBackupPlan -> Maybe Text
$sel:backupPlanTags:CreateBackupPlan' :: CreateBackupPlan -> Maybe (Sensitive (HashMap Text Text))
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive (HashMap Text Text))
backupPlanTags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
creatorRequestId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` BackupPlanInput
backupPlan

instance Prelude.NFData CreateBackupPlan where
  rnf :: CreateBackupPlan -> ()
rnf CreateBackupPlan' {Maybe Text
Maybe (Sensitive (HashMap Text Text))
BackupPlanInput
backupPlan :: BackupPlanInput
creatorRequestId :: Maybe Text
backupPlanTags :: Maybe (Sensitive (HashMap Text Text))
$sel:backupPlan:CreateBackupPlan' :: CreateBackupPlan -> BackupPlanInput
$sel:creatorRequestId:CreateBackupPlan' :: CreateBackupPlan -> Maybe Text
$sel:backupPlanTags:CreateBackupPlan' :: CreateBackupPlan -> Maybe (Sensitive (HashMap Text Text))
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive (HashMap Text Text))
backupPlanTags
      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 BackupPlanInput
backupPlan

instance Data.ToHeaders CreateBackupPlan where
  toHeaders :: CreateBackupPlan -> 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.ToJSON CreateBackupPlan where
  toJSON :: CreateBackupPlan -> Value
toJSON CreateBackupPlan' {Maybe Text
Maybe (Sensitive (HashMap Text Text))
BackupPlanInput
backupPlan :: BackupPlanInput
creatorRequestId :: Maybe Text
backupPlanTags :: Maybe (Sensitive (HashMap Text Text))
$sel:backupPlan:CreateBackupPlan' :: CreateBackupPlan -> BackupPlanInput
$sel:creatorRequestId:CreateBackupPlan' :: CreateBackupPlan -> Maybe Text
$sel:backupPlanTags:CreateBackupPlan' :: CreateBackupPlan -> Maybe (Sensitive (HashMap Text Text))
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"BackupPlanTags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Sensitive (HashMap Text Text))
backupPlanTags,
            (Key
"CreatorRequestId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
creatorRequestId,
            forall a. a -> Maybe a
Prelude.Just (Key
"BackupPlan" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= BackupPlanInput
backupPlan)
          ]
      )

instance Data.ToPath CreateBackupPlan where
  toPath :: CreateBackupPlan -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/backup/plans/"

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

-- | /See:/ 'newCreateBackupPlanResponse' smart constructor.
data CreateBackupPlanResponse = CreateBackupPlanResponse'
  { -- | A list of @BackupOptions@ settings for a resource type. This option is
    -- only available for Windows Volume Shadow Copy Service (VSS) backup jobs.
    CreateBackupPlanResponse -> Maybe [AdvancedBackupSetting]
advancedBackupSettings :: Prelude.Maybe [AdvancedBackupSetting],
    -- | 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@.
    CreateBackupPlanResponse -> Maybe Text
backupPlanArn :: Prelude.Maybe Prelude.Text,
    -- | Uniquely identifies a backup plan.
    CreateBackupPlanResponse -> 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.
    CreateBackupPlanResponse -> Maybe POSIX
creationDate :: Prelude.Maybe Data.POSIX,
    -- | Unique, randomly generated, Unicode, UTF-8 encoded strings that are at
    -- most 1,024 bytes long. They cannot be edited.
    CreateBackupPlanResponse -> Maybe Text
versionId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateBackupPlanResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateBackupPlanResponse -> CreateBackupPlanResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateBackupPlanResponse -> CreateBackupPlanResponse -> Bool
$c/= :: CreateBackupPlanResponse -> CreateBackupPlanResponse -> Bool
== :: CreateBackupPlanResponse -> CreateBackupPlanResponse -> Bool
$c== :: CreateBackupPlanResponse -> CreateBackupPlanResponse -> Bool
Prelude.Eq, ReadPrec [CreateBackupPlanResponse]
ReadPrec CreateBackupPlanResponse
Int -> ReadS CreateBackupPlanResponse
ReadS [CreateBackupPlanResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateBackupPlanResponse]
$creadListPrec :: ReadPrec [CreateBackupPlanResponse]
readPrec :: ReadPrec CreateBackupPlanResponse
$creadPrec :: ReadPrec CreateBackupPlanResponse
readList :: ReadS [CreateBackupPlanResponse]
$creadList :: ReadS [CreateBackupPlanResponse]
readsPrec :: Int -> ReadS CreateBackupPlanResponse
$creadsPrec :: Int -> ReadS CreateBackupPlanResponse
Prelude.Read, Int -> CreateBackupPlanResponse -> ShowS
[CreateBackupPlanResponse] -> ShowS
CreateBackupPlanResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateBackupPlanResponse] -> ShowS
$cshowList :: [CreateBackupPlanResponse] -> ShowS
show :: CreateBackupPlanResponse -> String
$cshow :: CreateBackupPlanResponse -> String
showsPrec :: Int -> CreateBackupPlanResponse -> ShowS
$cshowsPrec :: Int -> CreateBackupPlanResponse -> ShowS
Prelude.Show, forall x.
Rep CreateBackupPlanResponse x -> CreateBackupPlanResponse
forall x.
CreateBackupPlanResponse -> Rep CreateBackupPlanResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateBackupPlanResponse x -> CreateBackupPlanResponse
$cfrom :: forall x.
CreateBackupPlanResponse -> Rep CreateBackupPlanResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateBackupPlanResponse' 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', 'createBackupPlanResponse_advancedBackupSettings' - A list of @BackupOptions@ settings for a resource type. This option is
-- only available for Windows Volume Shadow Copy Service (VSS) backup jobs.
--
-- 'backupPlanArn', 'createBackupPlanResponse_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', 'createBackupPlanResponse_backupPlanId' - Uniquely identifies a backup plan.
--
-- 'creationDate', 'createBackupPlanResponse_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.
--
-- 'versionId', 'createBackupPlanResponse_versionId' - Unique, randomly generated, Unicode, UTF-8 encoded strings that are at
-- most 1,024 bytes long. They cannot be edited.
--
-- 'httpStatus', 'createBackupPlanResponse_httpStatus' - The response's http status code.
newCreateBackupPlanResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateBackupPlanResponse
newCreateBackupPlanResponse :: Int -> CreateBackupPlanResponse
newCreateBackupPlanResponse Int
pHttpStatus_ =
  CreateBackupPlanResponse'
    { $sel:advancedBackupSettings:CreateBackupPlanResponse' :: Maybe [AdvancedBackupSetting]
advancedBackupSettings =
        forall a. Maybe a
Prelude.Nothing,
      $sel:backupPlanArn:CreateBackupPlanResponse' :: Maybe Text
backupPlanArn = forall a. Maybe a
Prelude.Nothing,
      $sel:backupPlanId:CreateBackupPlanResponse' :: Maybe Text
backupPlanId = forall a. Maybe a
Prelude.Nothing,
      $sel:creationDate:CreateBackupPlanResponse' :: Maybe POSIX
creationDate = forall a. Maybe a
Prelude.Nothing,
      $sel:versionId:CreateBackupPlanResponse' :: Maybe Text
versionId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateBackupPlanResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of @BackupOptions@ settings for a resource type. This option is
-- only available for Windows Volume Shadow Copy Service (VSS) backup jobs.
createBackupPlanResponse_advancedBackupSettings :: Lens.Lens' CreateBackupPlanResponse (Prelude.Maybe [AdvancedBackupSetting])
createBackupPlanResponse_advancedBackupSettings :: Lens' CreateBackupPlanResponse (Maybe [AdvancedBackupSetting])
createBackupPlanResponse_advancedBackupSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBackupPlanResponse' {Maybe [AdvancedBackupSetting]
advancedBackupSettings :: Maybe [AdvancedBackupSetting]
$sel:advancedBackupSettings:CreateBackupPlanResponse' :: CreateBackupPlanResponse -> Maybe [AdvancedBackupSetting]
advancedBackupSettings} -> Maybe [AdvancedBackupSetting]
advancedBackupSettings) (\s :: CreateBackupPlanResponse
s@CreateBackupPlanResponse' {} Maybe [AdvancedBackupSetting]
a -> CreateBackupPlanResponse
s {$sel:advancedBackupSettings:CreateBackupPlanResponse' :: Maybe [AdvancedBackupSetting]
advancedBackupSettings = Maybe [AdvancedBackupSetting]
a} :: CreateBackupPlanResponse) 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

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

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

-- | 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.
createBackupPlanResponse_creationDate :: Lens.Lens' CreateBackupPlanResponse (Prelude.Maybe Prelude.UTCTime)
createBackupPlanResponse_creationDate :: Lens' CreateBackupPlanResponse (Maybe UTCTime)
createBackupPlanResponse_creationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBackupPlanResponse' {Maybe POSIX
creationDate :: Maybe POSIX
$sel:creationDate:CreateBackupPlanResponse' :: CreateBackupPlanResponse -> Maybe POSIX
creationDate} -> Maybe POSIX
creationDate) (\s :: CreateBackupPlanResponse
s@CreateBackupPlanResponse' {} Maybe POSIX
a -> CreateBackupPlanResponse
s {$sel:creationDate:CreateBackupPlanResponse' :: Maybe POSIX
creationDate = Maybe POSIX
a} :: CreateBackupPlanResponse) 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. They cannot be edited.
createBackupPlanResponse_versionId :: Lens.Lens' CreateBackupPlanResponse (Prelude.Maybe Prelude.Text)
createBackupPlanResponse_versionId :: Lens' CreateBackupPlanResponse (Maybe Text)
createBackupPlanResponse_versionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateBackupPlanResponse' {Maybe Text
versionId :: Maybe Text
$sel:versionId:CreateBackupPlanResponse' :: CreateBackupPlanResponse -> Maybe Text
versionId} -> Maybe Text
versionId) (\s :: CreateBackupPlanResponse
s@CreateBackupPlanResponse' {} Maybe Text
a -> CreateBackupPlanResponse
s {$sel:versionId:CreateBackupPlanResponse' :: Maybe Text
versionId = Maybe Text
a} :: CreateBackupPlanResponse)

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

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