{-# 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.UpdateBackupPlan
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates an existing backup plan identified by its @backupPlanId@ with
-- the input document in JSON format. The new version is uniquely
-- identified by a @VersionId@.
module Amazonka.Backup.UpdateBackupPlan
  ( -- * Creating a Request
    UpdateBackupPlan (..),
    newUpdateBackupPlan,

    -- * Request Lenses
    updateBackupPlan_backupPlanId,
    updateBackupPlan_backupPlan,

    -- * Destructuring the Response
    UpdateBackupPlanResponse (..),
    newUpdateBackupPlanResponse,

    -- * Response Lenses
    updateBackupPlanResponse_advancedBackupSettings,
    updateBackupPlanResponse_backupPlanArn,
    updateBackupPlanResponse_backupPlanId,
    updateBackupPlanResponse_creationDate,
    updateBackupPlanResponse_versionId,
    updateBackupPlanResponse_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:/ 'newUpdateBackupPlan' smart constructor.
data UpdateBackupPlan = UpdateBackupPlan'
  { -- | Uniquely identifies a backup plan.
    UpdateBackupPlan -> Text
backupPlanId :: Prelude.Text,
    -- | Specifies the body of a backup plan. Includes a @BackupPlanName@ and one
    -- or more sets of @Rules@.
    UpdateBackupPlan -> BackupPlanInput
backupPlan :: BackupPlanInput
  }
  deriving (UpdateBackupPlan -> UpdateBackupPlan -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateBackupPlan -> UpdateBackupPlan -> Bool
$c/= :: UpdateBackupPlan -> UpdateBackupPlan -> Bool
== :: UpdateBackupPlan -> UpdateBackupPlan -> Bool
$c== :: UpdateBackupPlan -> UpdateBackupPlan -> Bool
Prelude.Eq, Int -> UpdateBackupPlan -> ShowS
[UpdateBackupPlan] -> ShowS
UpdateBackupPlan -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateBackupPlan] -> ShowS
$cshowList :: [UpdateBackupPlan] -> ShowS
show :: UpdateBackupPlan -> String
$cshow :: UpdateBackupPlan -> String
showsPrec :: Int -> UpdateBackupPlan -> ShowS
$cshowsPrec :: Int -> UpdateBackupPlan -> ShowS
Prelude.Show, forall x. Rep UpdateBackupPlan x -> UpdateBackupPlan
forall x. UpdateBackupPlan -> Rep UpdateBackupPlan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateBackupPlan x -> UpdateBackupPlan
$cfrom :: forall x. UpdateBackupPlan -> Rep UpdateBackupPlan x
Prelude.Generic)

-- |
-- Create a value of 'UpdateBackupPlan' 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:
--
-- 'backupPlanId', 'updateBackupPlan_backupPlanId' - Uniquely identifies a backup plan.
--
-- 'backupPlan', 'updateBackupPlan_backupPlan' - Specifies the body of a backup plan. Includes a @BackupPlanName@ and one
-- or more sets of @Rules@.
newUpdateBackupPlan ::
  -- | 'backupPlanId'
  Prelude.Text ->
  -- | 'backupPlan'
  BackupPlanInput ->
  UpdateBackupPlan
newUpdateBackupPlan :: Text -> BackupPlanInput -> UpdateBackupPlan
newUpdateBackupPlan Text
pBackupPlanId_ BackupPlanInput
pBackupPlan_ =
  UpdateBackupPlan'
    { $sel:backupPlanId:UpdateBackupPlan' :: Text
backupPlanId = Text
pBackupPlanId_,
      $sel:backupPlan:UpdateBackupPlan' :: BackupPlanInput
backupPlan = BackupPlanInput
pBackupPlan_
    }

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

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

instance Core.AWSRequest UpdateBackupPlan where
  type
    AWSResponse UpdateBackupPlan =
      UpdateBackupPlanResponse
  request :: (Service -> Service)
-> UpdateBackupPlan -> Request UpdateBackupPlan
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateBackupPlan
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateBackupPlan)))
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
-> UpdateBackupPlanResponse
UpdateBackupPlanResponse'
            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 UpdateBackupPlan where
  hashWithSalt :: Int -> UpdateBackupPlan -> Int
hashWithSalt Int
_salt UpdateBackupPlan' {Text
BackupPlanInput
backupPlan :: BackupPlanInput
backupPlanId :: Text
$sel:backupPlan:UpdateBackupPlan' :: UpdateBackupPlan -> BackupPlanInput
$sel:backupPlanId:UpdateBackupPlan' :: UpdateBackupPlan -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
backupPlanId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` BackupPlanInput
backupPlan

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

instance Data.ToHeaders UpdateBackupPlan where
  toHeaders :: UpdateBackupPlan -> 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 UpdateBackupPlan where
  toJSON :: UpdateBackupPlan -> Value
toJSON UpdateBackupPlan' {Text
BackupPlanInput
backupPlan :: BackupPlanInput
backupPlanId :: Text
$sel:backupPlan:UpdateBackupPlan' :: UpdateBackupPlan -> BackupPlanInput
$sel:backupPlanId:UpdateBackupPlan' :: UpdateBackupPlan -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [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 UpdateBackupPlan where
  toPath :: UpdateBackupPlan -> ByteString
toPath UpdateBackupPlan' {Text
BackupPlanInput
backupPlan :: BackupPlanInput
backupPlanId :: Text
$sel:backupPlan:UpdateBackupPlan' :: UpdateBackupPlan -> BackupPlanInput
$sel:backupPlanId:UpdateBackupPlan' :: UpdateBackupPlan -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/backup/plans/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
backupPlanId]

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

-- | /See:/ 'newUpdateBackupPlanResponse' smart constructor.
data UpdateBackupPlanResponse = UpdateBackupPlanResponse'
  { -- | Contains a list of @BackupOptions@ for each resource type.
    UpdateBackupPlanResponse -> 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@.
    UpdateBackupPlanResponse -> Maybe Text
backupPlanArn :: Prelude.Maybe Prelude.Text,
    -- | Uniquely identifies a backup plan.
    UpdateBackupPlanResponse -> Maybe Text
backupPlanId :: Prelude.Maybe Prelude.Text,
    -- | The date and time 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.
    UpdateBackupPlanResponse -> Maybe POSIX
creationDate :: 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.
    UpdateBackupPlanResponse -> Maybe Text
versionId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    UpdateBackupPlanResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateBackupPlanResponse -> UpdateBackupPlanResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateBackupPlanResponse -> UpdateBackupPlanResponse -> Bool
$c/= :: UpdateBackupPlanResponse -> UpdateBackupPlanResponse -> Bool
== :: UpdateBackupPlanResponse -> UpdateBackupPlanResponse -> Bool
$c== :: UpdateBackupPlanResponse -> UpdateBackupPlanResponse -> Bool
Prelude.Eq, ReadPrec [UpdateBackupPlanResponse]
ReadPrec UpdateBackupPlanResponse
Int -> ReadS UpdateBackupPlanResponse
ReadS [UpdateBackupPlanResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateBackupPlanResponse]
$creadListPrec :: ReadPrec [UpdateBackupPlanResponse]
readPrec :: ReadPrec UpdateBackupPlanResponse
$creadPrec :: ReadPrec UpdateBackupPlanResponse
readList :: ReadS [UpdateBackupPlanResponse]
$creadList :: ReadS [UpdateBackupPlanResponse]
readsPrec :: Int -> ReadS UpdateBackupPlanResponse
$creadsPrec :: Int -> ReadS UpdateBackupPlanResponse
Prelude.Read, Int -> UpdateBackupPlanResponse -> ShowS
[UpdateBackupPlanResponse] -> ShowS
UpdateBackupPlanResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateBackupPlanResponse] -> ShowS
$cshowList :: [UpdateBackupPlanResponse] -> ShowS
show :: UpdateBackupPlanResponse -> String
$cshow :: UpdateBackupPlanResponse -> String
showsPrec :: Int -> UpdateBackupPlanResponse -> ShowS
$cshowsPrec :: Int -> UpdateBackupPlanResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateBackupPlanResponse x -> UpdateBackupPlanResponse
forall x.
UpdateBackupPlanResponse -> Rep UpdateBackupPlanResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateBackupPlanResponse x -> UpdateBackupPlanResponse
$cfrom :: forall x.
UpdateBackupPlanResponse -> Rep UpdateBackupPlanResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateBackupPlanResponse' 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', 'updateBackupPlanResponse_advancedBackupSettings' - Contains a list of @BackupOptions@ for each resource type.
--
-- 'backupPlanArn', 'updateBackupPlanResponse_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', 'updateBackupPlanResponse_backupPlanId' - Uniquely identifies a backup plan.
--
-- 'creationDate', 'updateBackupPlanResponse_creationDate' - The date and time 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', 'updateBackupPlanResponse_versionId' - Unique, randomly generated, Unicode, UTF-8 encoded strings that are at
-- most 1,024 bytes long. Version Ids cannot be edited.
--
-- 'httpStatus', 'updateBackupPlanResponse_httpStatus' - The response's http status code.
newUpdateBackupPlanResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateBackupPlanResponse
newUpdateBackupPlanResponse :: Int -> UpdateBackupPlanResponse
newUpdateBackupPlanResponse Int
pHttpStatus_ =
  UpdateBackupPlanResponse'
    { $sel:advancedBackupSettings:UpdateBackupPlanResponse' :: Maybe [AdvancedBackupSetting]
advancedBackupSettings =
        forall a. Maybe a
Prelude.Nothing,
      $sel:backupPlanArn:UpdateBackupPlanResponse' :: Maybe Text
backupPlanArn = forall a. Maybe a
Prelude.Nothing,
      $sel:backupPlanId:UpdateBackupPlanResponse' :: Maybe Text
backupPlanId = forall a. Maybe a
Prelude.Nothing,
      $sel:creationDate:UpdateBackupPlanResponse' :: Maybe POSIX
creationDate = forall a. Maybe a
Prelude.Nothing,
      $sel:versionId:UpdateBackupPlanResponse' :: Maybe Text
versionId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateBackupPlanResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Contains a list of @BackupOptions@ for each resource type.
updateBackupPlanResponse_advancedBackupSettings :: Lens.Lens' UpdateBackupPlanResponse (Prelude.Maybe [AdvancedBackupSetting])
updateBackupPlanResponse_advancedBackupSettings :: Lens' UpdateBackupPlanResponse (Maybe [AdvancedBackupSetting])
updateBackupPlanResponse_advancedBackupSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBackupPlanResponse' {Maybe [AdvancedBackupSetting]
advancedBackupSettings :: Maybe [AdvancedBackupSetting]
$sel:advancedBackupSettings:UpdateBackupPlanResponse' :: UpdateBackupPlanResponse -> Maybe [AdvancedBackupSetting]
advancedBackupSettings} -> Maybe [AdvancedBackupSetting]
advancedBackupSettings) (\s :: UpdateBackupPlanResponse
s@UpdateBackupPlanResponse' {} Maybe [AdvancedBackupSetting]
a -> UpdateBackupPlanResponse
s {$sel:advancedBackupSettings:UpdateBackupPlanResponse' :: Maybe [AdvancedBackupSetting]
advancedBackupSettings = Maybe [AdvancedBackupSetting]
a} :: UpdateBackupPlanResponse) 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@.
updateBackupPlanResponse_backupPlanArn :: Lens.Lens' UpdateBackupPlanResponse (Prelude.Maybe Prelude.Text)
updateBackupPlanResponse_backupPlanArn :: Lens' UpdateBackupPlanResponse (Maybe Text)
updateBackupPlanResponse_backupPlanArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBackupPlanResponse' {Maybe Text
backupPlanArn :: Maybe Text
$sel:backupPlanArn:UpdateBackupPlanResponse' :: UpdateBackupPlanResponse -> Maybe Text
backupPlanArn} -> Maybe Text
backupPlanArn) (\s :: UpdateBackupPlanResponse
s@UpdateBackupPlanResponse' {} Maybe Text
a -> UpdateBackupPlanResponse
s {$sel:backupPlanArn:UpdateBackupPlanResponse' :: Maybe Text
backupPlanArn = Maybe Text
a} :: UpdateBackupPlanResponse)

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

-- | The date and time 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.
updateBackupPlanResponse_creationDate :: Lens.Lens' UpdateBackupPlanResponse (Prelude.Maybe Prelude.UTCTime)
updateBackupPlanResponse_creationDate :: Lens' UpdateBackupPlanResponse (Maybe UTCTime)
updateBackupPlanResponse_creationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBackupPlanResponse' {Maybe POSIX
creationDate :: Maybe POSIX
$sel:creationDate:UpdateBackupPlanResponse' :: UpdateBackupPlanResponse -> Maybe POSIX
creationDate} -> Maybe POSIX
creationDate) (\s :: UpdateBackupPlanResponse
s@UpdateBackupPlanResponse' {} Maybe POSIX
a -> UpdateBackupPlanResponse
s {$sel:creationDate:UpdateBackupPlanResponse' :: Maybe POSIX
creationDate = Maybe POSIX
a} :: UpdateBackupPlanResponse) 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.
updateBackupPlanResponse_versionId :: Lens.Lens' UpdateBackupPlanResponse (Prelude.Maybe Prelude.Text)
updateBackupPlanResponse_versionId :: Lens' UpdateBackupPlanResponse (Maybe Text)
updateBackupPlanResponse_versionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBackupPlanResponse' {Maybe Text
versionId :: Maybe Text
$sel:versionId:UpdateBackupPlanResponse' :: UpdateBackupPlanResponse -> Maybe Text
versionId} -> Maybe Text
versionId) (\s :: UpdateBackupPlanResponse
s@UpdateBackupPlanResponse' {} Maybe Text
a -> UpdateBackupPlanResponse
s {$sel:versionId:UpdateBackupPlanResponse' :: Maybe Text
versionId = Maybe Text
a} :: UpdateBackupPlanResponse)

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

instance Prelude.NFData UpdateBackupPlanResponse where
  rnf :: UpdateBackupPlanResponse -> ()
rnf UpdateBackupPlanResponse' {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:UpdateBackupPlanResponse' :: UpdateBackupPlanResponse -> Int
$sel:versionId:UpdateBackupPlanResponse' :: UpdateBackupPlanResponse -> Maybe Text
$sel:creationDate:UpdateBackupPlanResponse' :: UpdateBackupPlanResponse -> Maybe POSIX
$sel:backupPlanId:UpdateBackupPlanResponse' :: UpdateBackupPlanResponse -> Maybe Text
$sel:backupPlanArn:UpdateBackupPlanResponse' :: UpdateBackupPlanResponse -> Maybe Text
$sel:advancedBackupSettings:UpdateBackupPlanResponse' :: UpdateBackupPlanResponse -> 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