{-# 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.StartBackupJob
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Starts an on-demand backup job for the specified resource.
module Amazonka.Backup.StartBackupJob
  ( -- * Creating a Request
    StartBackupJob (..),
    newStartBackupJob,

    -- * Request Lenses
    startBackupJob_backupOptions,
    startBackupJob_completeWindowMinutes,
    startBackupJob_idempotencyToken,
    startBackupJob_lifecycle,
    startBackupJob_recoveryPointTags,
    startBackupJob_startWindowMinutes,
    startBackupJob_backupVaultName,
    startBackupJob_resourceArn,
    startBackupJob_iamRoleArn,

    -- * Destructuring the Response
    StartBackupJobResponse (..),
    newStartBackupJobResponse,

    -- * Response Lenses
    startBackupJobResponse_backupJobId,
    startBackupJobResponse_creationDate,
    startBackupJobResponse_isParent,
    startBackupJobResponse_recoveryPointArn,
    startBackupJobResponse_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:/ 'newStartBackupJob' smart constructor.
data StartBackupJob = StartBackupJob'
  { -- | Specifies the backup option for a selected resource. This option is only
    -- available for Windows Volume Shadow Copy Service (VSS) backup jobs.
    --
    -- Valid values: Set to @\"WindowsVSS\":\"enabled\"@ to enable the
    -- @WindowsVSS@ backup option and create a Windows VSS backup. Set to
    -- @\"WindowsVSS\"\"disabled\"@ to create a regular backup. The
    -- @WindowsVSS@ option is not enabled by default.
    StartBackupJob -> Maybe (HashMap Text Text)
backupOptions :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A value in minutes during which a successfully started backup must
    -- complete, or else Backup will cancel the job. This value is optional.
    -- This value begins counting down from when the backup was scheduled. It
    -- does not add additional time for @StartWindowMinutes@, or if the backup
    -- started later than scheduled.
    StartBackupJob -> Maybe Integer
completeWindowMinutes :: Prelude.Maybe Prelude.Integer,
    -- | A customer-chosen string that you can use to distinguish between
    -- otherwise identical calls to @StartBackupJob@. Retrying a successful
    -- request with the same idempotency token results in a success message
    -- with no action taken.
    StartBackupJob -> Maybe Text
idempotencyToken :: Prelude.Maybe Prelude.Text,
    -- | The lifecycle defines when a protected resource is transitioned to cold
    -- storage and when it expires. Backup will transition and expire backups
    -- automatically according to the lifecycle that you define.
    --
    -- Backups transitioned to cold storage must be stored in cold storage for
    -- a minimum of 90 days. Therefore, the “retention” setting must be 90 days
    -- greater than the “transition to cold after days” setting. The
    -- “transition to cold after days” setting cannot be changed after a backup
    -- has been transitioned to cold.
    --
    -- Resource types that are able to be transitioned to cold storage are
    -- listed in the \"Lifecycle to cold storage\" section of the
    -- <https://docs.aws.amazon.com/aws-backup/latest/devguide/whatisbackup.html#features-by-resource Feature availability by resource>
    -- table. Backup ignores this expression for other resource types.
    StartBackupJob -> Maybe Lifecycle
lifecycle :: Prelude.Maybe Lifecycle,
    -- | To help organize your resources, you can assign your own metadata to the
    -- resources that you create. Each tag is a key-value pair.
    StartBackupJob -> Maybe (Sensitive (HashMap Text Text))
recoveryPointTags :: Prelude.Maybe (Data.Sensitive (Prelude.HashMap Prelude.Text Prelude.Text)),
    -- | A value in minutes after a backup is scheduled before a job will be
    -- canceled if it doesn\'t start successfully. This value is optional, and
    -- the default is 8 hours. If this value is included, it must be at least
    -- 60 minutes to avoid errors.
    StartBackupJob -> Maybe Integer
startWindowMinutes :: Prelude.Maybe Prelude.Integer,
    -- | 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.
    StartBackupJob -> Text
backupVaultName :: Prelude.Text,
    -- | An Amazon Resource Name (ARN) that uniquely identifies a resource. The
    -- format of the ARN depends on the resource type.
    StartBackupJob -> Text
resourceArn :: Prelude.Text,
    -- | Specifies the IAM role ARN used to create the target recovery point; for
    -- example, @arn:aws:iam::123456789012:role\/S3Access@.
    StartBackupJob -> Text
iamRoleArn :: Prelude.Text
  }
  deriving (StartBackupJob -> StartBackupJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartBackupJob -> StartBackupJob -> Bool
$c/= :: StartBackupJob -> StartBackupJob -> Bool
== :: StartBackupJob -> StartBackupJob -> Bool
$c== :: StartBackupJob -> StartBackupJob -> Bool
Prelude.Eq, Int -> StartBackupJob -> ShowS
[StartBackupJob] -> ShowS
StartBackupJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartBackupJob] -> ShowS
$cshowList :: [StartBackupJob] -> ShowS
show :: StartBackupJob -> String
$cshow :: StartBackupJob -> String
showsPrec :: Int -> StartBackupJob -> ShowS
$cshowsPrec :: Int -> StartBackupJob -> ShowS
Prelude.Show, forall x. Rep StartBackupJob x -> StartBackupJob
forall x. StartBackupJob -> Rep StartBackupJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartBackupJob x -> StartBackupJob
$cfrom :: forall x. StartBackupJob -> Rep StartBackupJob x
Prelude.Generic)

-- |
-- Create a value of 'StartBackupJob' 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:
--
-- 'backupOptions', 'startBackupJob_backupOptions' - Specifies the backup option for a selected resource. This option is only
-- available for Windows Volume Shadow Copy Service (VSS) backup jobs.
--
-- Valid values: Set to @\"WindowsVSS\":\"enabled\"@ to enable the
-- @WindowsVSS@ backup option and create a Windows VSS backup. Set to
-- @\"WindowsVSS\"\"disabled\"@ to create a regular backup. The
-- @WindowsVSS@ option is not enabled by default.
--
-- 'completeWindowMinutes', 'startBackupJob_completeWindowMinutes' - A value in minutes during which a successfully started backup must
-- complete, or else Backup will cancel the job. This value is optional.
-- This value begins counting down from when the backup was scheduled. It
-- does not add additional time for @StartWindowMinutes@, or if the backup
-- started later than scheduled.
--
-- 'idempotencyToken', 'startBackupJob_idempotencyToken' - A customer-chosen string that you can use to distinguish between
-- otherwise identical calls to @StartBackupJob@. Retrying a successful
-- request with the same idempotency token results in a success message
-- with no action taken.
--
-- 'lifecycle', 'startBackupJob_lifecycle' - The lifecycle defines when a protected resource is transitioned to cold
-- storage and when it expires. Backup will transition and expire backups
-- automatically according to the lifecycle that you define.
--
-- Backups transitioned to cold storage must be stored in cold storage for
-- a minimum of 90 days. Therefore, the “retention” setting must be 90 days
-- greater than the “transition to cold after days” setting. The
-- “transition to cold after days” setting cannot be changed after a backup
-- has been transitioned to cold.
--
-- Resource types that are able to be transitioned to cold storage are
-- listed in the \"Lifecycle to cold storage\" section of the
-- <https://docs.aws.amazon.com/aws-backup/latest/devguide/whatisbackup.html#features-by-resource Feature availability by resource>
-- table. Backup ignores this expression for other resource types.
--
-- 'recoveryPointTags', 'startBackupJob_recoveryPointTags' - To help organize your resources, you can assign your own metadata to the
-- resources that you create. Each tag is a key-value pair.
--
-- 'startWindowMinutes', 'startBackupJob_startWindowMinutes' - A value in minutes after a backup is scheduled before a job will be
-- canceled if it doesn\'t start successfully. This value is optional, and
-- the default is 8 hours. If this value is included, it must be at least
-- 60 minutes to avoid errors.
--
-- 'backupVaultName', 'startBackupJob_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.
--
-- 'resourceArn', 'startBackupJob_resourceArn' - An Amazon Resource Name (ARN) that uniquely identifies a resource. The
-- format of the ARN depends on the resource type.
--
-- 'iamRoleArn', 'startBackupJob_iamRoleArn' - Specifies the IAM role ARN used to create the target recovery point; for
-- example, @arn:aws:iam::123456789012:role\/S3Access@.
newStartBackupJob ::
  -- | 'backupVaultName'
  Prelude.Text ->
  -- | 'resourceArn'
  Prelude.Text ->
  -- | 'iamRoleArn'
  Prelude.Text ->
  StartBackupJob
newStartBackupJob :: Text -> Text -> Text -> StartBackupJob
newStartBackupJob
  Text
pBackupVaultName_
  Text
pResourceArn_
  Text
pIamRoleArn_ =
    StartBackupJob'
      { $sel:backupOptions:StartBackupJob' :: Maybe (HashMap Text Text)
backupOptions = forall a. Maybe a
Prelude.Nothing,
        $sel:completeWindowMinutes:StartBackupJob' :: Maybe Integer
completeWindowMinutes = forall a. Maybe a
Prelude.Nothing,
        $sel:idempotencyToken:StartBackupJob' :: Maybe Text
idempotencyToken = forall a. Maybe a
Prelude.Nothing,
        $sel:lifecycle:StartBackupJob' :: Maybe Lifecycle
lifecycle = forall a. Maybe a
Prelude.Nothing,
        $sel:recoveryPointTags:StartBackupJob' :: Maybe (Sensitive (HashMap Text Text))
recoveryPointTags = forall a. Maybe a
Prelude.Nothing,
        $sel:startWindowMinutes:StartBackupJob' :: Maybe Integer
startWindowMinutes = forall a. Maybe a
Prelude.Nothing,
        $sel:backupVaultName:StartBackupJob' :: Text
backupVaultName = Text
pBackupVaultName_,
        $sel:resourceArn:StartBackupJob' :: Text
resourceArn = Text
pResourceArn_,
        $sel:iamRoleArn:StartBackupJob' :: Text
iamRoleArn = Text
pIamRoleArn_
      }

-- | Specifies the backup option for a selected resource. This option is only
-- available for Windows Volume Shadow Copy Service (VSS) backup jobs.
--
-- Valid values: Set to @\"WindowsVSS\":\"enabled\"@ to enable the
-- @WindowsVSS@ backup option and create a Windows VSS backup. Set to
-- @\"WindowsVSS\"\"disabled\"@ to create a regular backup. The
-- @WindowsVSS@ option is not enabled by default.
startBackupJob_backupOptions :: Lens.Lens' StartBackupJob (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
startBackupJob_backupOptions :: Lens' StartBackupJob (Maybe (HashMap Text Text))
startBackupJob_backupOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBackupJob' {Maybe (HashMap Text Text)
backupOptions :: Maybe (HashMap Text Text)
$sel:backupOptions:StartBackupJob' :: StartBackupJob -> Maybe (HashMap Text Text)
backupOptions} -> Maybe (HashMap Text Text)
backupOptions) (\s :: StartBackupJob
s@StartBackupJob' {} Maybe (HashMap Text Text)
a -> StartBackupJob
s {$sel:backupOptions:StartBackupJob' :: Maybe (HashMap Text Text)
backupOptions = Maybe (HashMap Text Text)
a} :: StartBackupJob) 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

-- | A value in minutes during which a successfully started backup must
-- complete, or else Backup will cancel the job. This value is optional.
-- This value begins counting down from when the backup was scheduled. It
-- does not add additional time for @StartWindowMinutes@, or if the backup
-- started later than scheduled.
startBackupJob_completeWindowMinutes :: Lens.Lens' StartBackupJob (Prelude.Maybe Prelude.Integer)
startBackupJob_completeWindowMinutes :: Lens' StartBackupJob (Maybe Integer)
startBackupJob_completeWindowMinutes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBackupJob' {Maybe Integer
completeWindowMinutes :: Maybe Integer
$sel:completeWindowMinutes:StartBackupJob' :: StartBackupJob -> Maybe Integer
completeWindowMinutes} -> Maybe Integer
completeWindowMinutes) (\s :: StartBackupJob
s@StartBackupJob' {} Maybe Integer
a -> StartBackupJob
s {$sel:completeWindowMinutes:StartBackupJob' :: Maybe Integer
completeWindowMinutes = Maybe Integer
a} :: StartBackupJob)

-- | A customer-chosen string that you can use to distinguish between
-- otherwise identical calls to @StartBackupJob@. Retrying a successful
-- request with the same idempotency token results in a success message
-- with no action taken.
startBackupJob_idempotencyToken :: Lens.Lens' StartBackupJob (Prelude.Maybe Prelude.Text)
startBackupJob_idempotencyToken :: Lens' StartBackupJob (Maybe Text)
startBackupJob_idempotencyToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBackupJob' {Maybe Text
idempotencyToken :: Maybe Text
$sel:idempotencyToken:StartBackupJob' :: StartBackupJob -> Maybe Text
idempotencyToken} -> Maybe Text
idempotencyToken) (\s :: StartBackupJob
s@StartBackupJob' {} Maybe Text
a -> StartBackupJob
s {$sel:idempotencyToken:StartBackupJob' :: Maybe Text
idempotencyToken = Maybe Text
a} :: StartBackupJob)

-- | The lifecycle defines when a protected resource is transitioned to cold
-- storage and when it expires. Backup will transition and expire backups
-- automatically according to the lifecycle that you define.
--
-- Backups transitioned to cold storage must be stored in cold storage for
-- a minimum of 90 days. Therefore, the “retention” setting must be 90 days
-- greater than the “transition to cold after days” setting. The
-- “transition to cold after days” setting cannot be changed after a backup
-- has been transitioned to cold.
--
-- Resource types that are able to be transitioned to cold storage are
-- listed in the \"Lifecycle to cold storage\" section of the
-- <https://docs.aws.amazon.com/aws-backup/latest/devguide/whatisbackup.html#features-by-resource Feature availability by resource>
-- table. Backup ignores this expression for other resource types.
startBackupJob_lifecycle :: Lens.Lens' StartBackupJob (Prelude.Maybe Lifecycle)
startBackupJob_lifecycle :: Lens' StartBackupJob (Maybe Lifecycle)
startBackupJob_lifecycle = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBackupJob' {Maybe Lifecycle
lifecycle :: Maybe Lifecycle
$sel:lifecycle:StartBackupJob' :: StartBackupJob -> Maybe Lifecycle
lifecycle} -> Maybe Lifecycle
lifecycle) (\s :: StartBackupJob
s@StartBackupJob' {} Maybe Lifecycle
a -> StartBackupJob
s {$sel:lifecycle:StartBackupJob' :: Maybe Lifecycle
lifecycle = Maybe Lifecycle
a} :: StartBackupJob)

-- | To help organize your resources, you can assign your own metadata to the
-- resources that you create. Each tag is a key-value pair.
startBackupJob_recoveryPointTags :: Lens.Lens' StartBackupJob (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
startBackupJob_recoveryPointTags :: Lens' StartBackupJob (Maybe (HashMap Text Text))
startBackupJob_recoveryPointTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBackupJob' {Maybe (Sensitive (HashMap Text Text))
recoveryPointTags :: Maybe (Sensitive (HashMap Text Text))
$sel:recoveryPointTags:StartBackupJob' :: StartBackupJob -> Maybe (Sensitive (HashMap Text Text))
recoveryPointTags} -> Maybe (Sensitive (HashMap Text Text))
recoveryPointTags) (\s :: StartBackupJob
s@StartBackupJob' {} Maybe (Sensitive (HashMap Text Text))
a -> StartBackupJob
s {$sel:recoveryPointTags:StartBackupJob' :: Maybe (Sensitive (HashMap Text Text))
recoveryPointTags = Maybe (Sensitive (HashMap Text Text))
a} :: StartBackupJob) 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)

-- | A value in minutes after a backup is scheduled before a job will be
-- canceled if it doesn\'t start successfully. This value is optional, and
-- the default is 8 hours. If this value is included, it must be at least
-- 60 minutes to avoid errors.
startBackupJob_startWindowMinutes :: Lens.Lens' StartBackupJob (Prelude.Maybe Prelude.Integer)
startBackupJob_startWindowMinutes :: Lens' StartBackupJob (Maybe Integer)
startBackupJob_startWindowMinutes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBackupJob' {Maybe Integer
startWindowMinutes :: Maybe Integer
$sel:startWindowMinutes:StartBackupJob' :: StartBackupJob -> Maybe Integer
startWindowMinutes} -> Maybe Integer
startWindowMinutes) (\s :: StartBackupJob
s@StartBackupJob' {} Maybe Integer
a -> StartBackupJob
s {$sel:startWindowMinutes:StartBackupJob' :: Maybe Integer
startWindowMinutes = Maybe Integer
a} :: StartBackupJob)

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

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

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

instance Core.AWSRequest StartBackupJob where
  type
    AWSResponse StartBackupJob =
      StartBackupJobResponse
  request :: (Service -> Service) -> StartBackupJob -> Request StartBackupJob
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 StartBackupJob
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse StartBackupJob)))
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 POSIX
-> Maybe Bool
-> Maybe Text
-> Int
-> StartBackupJobResponse
StartBackupJobResponse'
            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
"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
"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
"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
"RecoveryPointArn")
            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 StartBackupJob where
  hashWithSalt :: Int -> StartBackupJob -> Int
hashWithSalt Int
_salt StartBackupJob' {Maybe Integer
Maybe Text
Maybe (HashMap Text Text)
Maybe (Sensitive (HashMap Text Text))
Maybe Lifecycle
Text
iamRoleArn :: Text
resourceArn :: Text
backupVaultName :: Text
startWindowMinutes :: Maybe Integer
recoveryPointTags :: Maybe (Sensitive (HashMap Text Text))
lifecycle :: Maybe Lifecycle
idempotencyToken :: Maybe Text
completeWindowMinutes :: Maybe Integer
backupOptions :: Maybe (HashMap Text Text)
$sel:iamRoleArn:StartBackupJob' :: StartBackupJob -> Text
$sel:resourceArn:StartBackupJob' :: StartBackupJob -> Text
$sel:backupVaultName:StartBackupJob' :: StartBackupJob -> Text
$sel:startWindowMinutes:StartBackupJob' :: StartBackupJob -> Maybe Integer
$sel:recoveryPointTags:StartBackupJob' :: StartBackupJob -> Maybe (Sensitive (HashMap Text Text))
$sel:lifecycle:StartBackupJob' :: StartBackupJob -> Maybe Lifecycle
$sel:idempotencyToken:StartBackupJob' :: StartBackupJob -> Maybe Text
$sel:completeWindowMinutes:StartBackupJob' :: StartBackupJob -> Maybe Integer
$sel:backupOptions:StartBackupJob' :: StartBackupJob -> Maybe (HashMap Text Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
backupOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
completeWindowMinutes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
idempotencyToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Lifecycle
lifecycle
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive (HashMap Text Text))
recoveryPointTags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
startWindowMinutes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
backupVaultName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
iamRoleArn

instance Prelude.NFData StartBackupJob where
  rnf :: StartBackupJob -> ()
rnf StartBackupJob' {Maybe Integer
Maybe Text
Maybe (HashMap Text Text)
Maybe (Sensitive (HashMap Text Text))
Maybe Lifecycle
Text
iamRoleArn :: Text
resourceArn :: Text
backupVaultName :: Text
startWindowMinutes :: Maybe Integer
recoveryPointTags :: Maybe (Sensitive (HashMap Text Text))
lifecycle :: Maybe Lifecycle
idempotencyToken :: Maybe Text
completeWindowMinutes :: Maybe Integer
backupOptions :: Maybe (HashMap Text Text)
$sel:iamRoleArn:StartBackupJob' :: StartBackupJob -> Text
$sel:resourceArn:StartBackupJob' :: StartBackupJob -> Text
$sel:backupVaultName:StartBackupJob' :: StartBackupJob -> Text
$sel:startWindowMinutes:StartBackupJob' :: StartBackupJob -> Maybe Integer
$sel:recoveryPointTags:StartBackupJob' :: StartBackupJob -> Maybe (Sensitive (HashMap Text Text))
$sel:lifecycle:StartBackupJob' :: StartBackupJob -> Maybe Lifecycle
$sel:idempotencyToken:StartBackupJob' :: StartBackupJob -> Maybe Text
$sel:completeWindowMinutes:StartBackupJob' :: StartBackupJob -> Maybe Integer
$sel:backupOptions:StartBackupJob' :: StartBackupJob -> Maybe (HashMap Text Text)
..} =
    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
completeWindowMinutes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
idempotencyToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Lifecycle
lifecycle
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive (HashMap Text Text))
recoveryPointTags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
startWindowMinutes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
backupVaultName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
iamRoleArn

instance Data.ToHeaders StartBackupJob where
  toHeaders :: StartBackupJob -> 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 StartBackupJob where
  toJSON :: StartBackupJob -> Value
toJSON StartBackupJob' {Maybe Integer
Maybe Text
Maybe (HashMap Text Text)
Maybe (Sensitive (HashMap Text Text))
Maybe Lifecycle
Text
iamRoleArn :: Text
resourceArn :: Text
backupVaultName :: Text
startWindowMinutes :: Maybe Integer
recoveryPointTags :: Maybe (Sensitive (HashMap Text Text))
lifecycle :: Maybe Lifecycle
idempotencyToken :: Maybe Text
completeWindowMinutes :: Maybe Integer
backupOptions :: Maybe (HashMap Text Text)
$sel:iamRoleArn:StartBackupJob' :: StartBackupJob -> Text
$sel:resourceArn:StartBackupJob' :: StartBackupJob -> Text
$sel:backupVaultName:StartBackupJob' :: StartBackupJob -> Text
$sel:startWindowMinutes:StartBackupJob' :: StartBackupJob -> Maybe Integer
$sel:recoveryPointTags:StartBackupJob' :: StartBackupJob -> Maybe (Sensitive (HashMap Text Text))
$sel:lifecycle:StartBackupJob' :: StartBackupJob -> Maybe Lifecycle
$sel:idempotencyToken:StartBackupJob' :: StartBackupJob -> Maybe Text
$sel:completeWindowMinutes:StartBackupJob' :: StartBackupJob -> Maybe Integer
$sel:backupOptions:StartBackupJob' :: StartBackupJob -> Maybe (HashMap Text Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"BackupOptions" 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 (HashMap Text Text)
backupOptions,
            (Key
"CompleteWindowMinutes" 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 Integer
completeWindowMinutes,
            (Key
"IdempotencyToken" 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
idempotencyToken,
            (Key
"Lifecycle" 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 Lifecycle
lifecycle,
            (Key
"RecoveryPointTags" 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))
recoveryPointTags,
            (Key
"StartWindowMinutes" 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 Integer
startWindowMinutes,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"BackupVaultName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
backupVaultName),
            forall a. a -> Maybe a
Prelude.Just (Key
"ResourceArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resourceArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"IamRoleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
iamRoleArn)
          ]
      )

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

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

-- | /See:/ 'newStartBackupJobResponse' smart constructor.
data StartBackupJobResponse = StartBackupJobResponse'
  { -- | Uniquely identifies a request to Backup to back up a resource.
    StartBackupJobResponse -> Maybe Text
backupJobId :: Prelude.Maybe Prelude.Text,
    -- | 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.
    StartBackupJobResponse -> Maybe POSIX
creationDate :: Prelude.Maybe Data.POSIX,
    -- | This is a returned boolean value indicating this is a parent (composite)
    -- backup job.
    StartBackupJobResponse -> Maybe Bool
isParent :: Prelude.Maybe Prelude.Bool,
    -- | An ARN that uniquely identifies a recovery point; for example,
    -- @arn:aws:backup:us-east-1:123456789012:recovery-point:1EB3B5E7-9EB0-435A-A80B-108B488B0D45@.
    StartBackupJobResponse -> Maybe Text
recoveryPointArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    StartBackupJobResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartBackupJobResponse -> StartBackupJobResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartBackupJobResponse -> StartBackupJobResponse -> Bool
$c/= :: StartBackupJobResponse -> StartBackupJobResponse -> Bool
== :: StartBackupJobResponse -> StartBackupJobResponse -> Bool
$c== :: StartBackupJobResponse -> StartBackupJobResponse -> Bool
Prelude.Eq, ReadPrec [StartBackupJobResponse]
ReadPrec StartBackupJobResponse
Int -> ReadS StartBackupJobResponse
ReadS [StartBackupJobResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartBackupJobResponse]
$creadListPrec :: ReadPrec [StartBackupJobResponse]
readPrec :: ReadPrec StartBackupJobResponse
$creadPrec :: ReadPrec StartBackupJobResponse
readList :: ReadS [StartBackupJobResponse]
$creadList :: ReadS [StartBackupJobResponse]
readsPrec :: Int -> ReadS StartBackupJobResponse
$creadsPrec :: Int -> ReadS StartBackupJobResponse
Prelude.Read, Int -> StartBackupJobResponse -> ShowS
[StartBackupJobResponse] -> ShowS
StartBackupJobResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartBackupJobResponse] -> ShowS
$cshowList :: [StartBackupJobResponse] -> ShowS
show :: StartBackupJobResponse -> String
$cshow :: StartBackupJobResponse -> String
showsPrec :: Int -> StartBackupJobResponse -> ShowS
$cshowsPrec :: Int -> StartBackupJobResponse -> ShowS
Prelude.Show, forall x. Rep StartBackupJobResponse x -> StartBackupJobResponse
forall x. StartBackupJobResponse -> Rep StartBackupJobResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartBackupJobResponse x -> StartBackupJobResponse
$cfrom :: forall x. StartBackupJobResponse -> Rep StartBackupJobResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartBackupJobResponse' 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', 'startBackupJobResponse_backupJobId' - Uniquely identifies a request to Backup to back up a resource.
--
-- 'creationDate', 'startBackupJobResponse_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.
--
-- 'isParent', 'startBackupJobResponse_isParent' - This is a returned boolean value indicating this is a parent (composite)
-- backup job.
--
-- 'recoveryPointArn', 'startBackupJobResponse_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@.
--
-- 'httpStatus', 'startBackupJobResponse_httpStatus' - The response's http status code.
newStartBackupJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartBackupJobResponse
newStartBackupJobResponse :: Int -> StartBackupJobResponse
newStartBackupJobResponse Int
pHttpStatus_ =
  StartBackupJobResponse'
    { $sel:backupJobId:StartBackupJobResponse' :: Maybe Text
backupJobId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:creationDate:StartBackupJobResponse' :: Maybe POSIX
creationDate = forall a. Maybe a
Prelude.Nothing,
      $sel:isParent:StartBackupJobResponse' :: Maybe Bool
isParent = forall a. Maybe a
Prelude.Nothing,
      $sel:recoveryPointArn:StartBackupJobResponse' :: Maybe Text
recoveryPointArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartBackupJobResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | 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.
startBackupJobResponse_creationDate :: Lens.Lens' StartBackupJobResponse (Prelude.Maybe Prelude.UTCTime)
startBackupJobResponse_creationDate :: Lens' StartBackupJobResponse (Maybe UTCTime)
startBackupJobResponse_creationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBackupJobResponse' {Maybe POSIX
creationDate :: Maybe POSIX
$sel:creationDate:StartBackupJobResponse' :: StartBackupJobResponse -> Maybe POSIX
creationDate} -> Maybe POSIX
creationDate) (\s :: StartBackupJobResponse
s@StartBackupJobResponse' {} Maybe POSIX
a -> StartBackupJobResponse
s {$sel:creationDate:StartBackupJobResponse' :: Maybe POSIX
creationDate = Maybe POSIX
a} :: StartBackupJobResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | This is a returned boolean value indicating this is a parent (composite)
-- backup job.
startBackupJobResponse_isParent :: Lens.Lens' StartBackupJobResponse (Prelude.Maybe Prelude.Bool)
startBackupJobResponse_isParent :: Lens' StartBackupJobResponse (Maybe Bool)
startBackupJobResponse_isParent = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartBackupJobResponse' {Maybe Bool
isParent :: Maybe Bool
$sel:isParent:StartBackupJobResponse' :: StartBackupJobResponse -> Maybe Bool
isParent} -> Maybe Bool
isParent) (\s :: StartBackupJobResponse
s@StartBackupJobResponse' {} Maybe Bool
a -> StartBackupJobResponse
s {$sel:isParent:StartBackupJobResponse' :: Maybe Bool
isParent = Maybe Bool
a} :: StartBackupJobResponse)

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

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

instance Prelude.NFData StartBackupJobResponse where
  rnf :: StartBackupJobResponse -> ()
rnf StartBackupJobResponse' {Int
Maybe Bool
Maybe Text
Maybe POSIX
httpStatus :: Int
recoveryPointArn :: Maybe Text
isParent :: Maybe Bool
creationDate :: Maybe POSIX
backupJobId :: Maybe Text
$sel:httpStatus:StartBackupJobResponse' :: StartBackupJobResponse -> Int
$sel:recoveryPointArn:StartBackupJobResponse' :: StartBackupJobResponse -> Maybe Text
$sel:isParent:StartBackupJobResponse' :: StartBackupJobResponse -> Maybe Bool
$sel:creationDate:StartBackupJobResponse' :: StartBackupJobResponse -> Maybe POSIX
$sel:backupJobId:StartBackupJobResponse' :: StartBackupJobResponse -> Maybe Text
..} =
    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 POSIX
creationDate
      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 Text
recoveryPointArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus