{-# 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.RDS.ModifyDBSnapshot
-- 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 a manual DB snapshot with a new engine version. The snapshot can
-- be encrypted or unencrypted, but not shared or public.
--
-- Amazon RDS supports upgrading DB snapshots for MySQL, PostgreSQL, and
-- Oracle. This command doesn\'t apply to RDS Custom.
module Amazonka.RDS.ModifyDBSnapshot
  ( -- * Creating a Request
    ModifyDBSnapshot (..),
    newModifyDBSnapshot,

    -- * Request Lenses
    modifyDBSnapshot_engineVersion,
    modifyDBSnapshot_optionGroupName,
    modifyDBSnapshot_dbSnapshotIdentifier,

    -- * Destructuring the Response
    ModifyDBSnapshotResponse (..),
    newModifyDBSnapshotResponse,

    -- * Response Lenses
    modifyDBSnapshotResponse_dbSnapshot,
    modifyDBSnapshotResponse_httpStatus,
  )
where

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 Amazonka.RDS.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newModifyDBSnapshot' smart constructor.
data ModifyDBSnapshot = ModifyDBSnapshot'
  { -- | The engine version to upgrade the DB snapshot to.
    --
    -- The following are the database engines and engine versions that are
    -- available when you upgrade a DB snapshot.
    --
    -- __MySQL__
    --
    -- -   @5.5.46@ (supported for 5.1 DB snapshots)
    --
    -- __Oracle__
    --
    -- -   @12.1.0.2.v8@ (supported for 12.1.0.1 DB snapshots)
    --
    -- -   @11.2.0.4.v12@ (supported for 11.2.0.2 DB snapshots)
    --
    -- -   @11.2.0.4.v11@ (supported for 11.2.0.3 DB snapshots)
    --
    -- __PostgreSQL__
    --
    -- For the list of engine versions that are available for upgrading a DB
    -- snapshot, see
    -- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/USER_UpgradeDBInstance.PostgreSQL.html#USER_UpgradeDBInstance.PostgreSQL.MajorVersion Upgrading the PostgreSQL DB Engine for Amazon RDS>.
    ModifyDBSnapshot -> Maybe Text
engineVersion :: Prelude.Maybe Prelude.Text,
    -- | The option group to identify with the upgraded DB snapshot.
    --
    -- You can specify this parameter when you upgrade an Oracle DB snapshot.
    -- The same option group considerations apply when upgrading a DB snapshot
    -- as when upgrading a DB instance. For more information, see
    -- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/USER_UpgradeDBInstance.Oracle.html#USER_UpgradeDBInstance.Oracle.OGPG.OG Option group considerations>
    -- in the /Amazon RDS User Guide./
    ModifyDBSnapshot -> Maybe Text
optionGroupName :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the DB snapshot to modify.
    ModifyDBSnapshot -> Text
dbSnapshotIdentifier :: Prelude.Text
  }
  deriving (ModifyDBSnapshot -> ModifyDBSnapshot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyDBSnapshot -> ModifyDBSnapshot -> Bool
$c/= :: ModifyDBSnapshot -> ModifyDBSnapshot -> Bool
== :: ModifyDBSnapshot -> ModifyDBSnapshot -> Bool
$c== :: ModifyDBSnapshot -> ModifyDBSnapshot -> Bool
Prelude.Eq, ReadPrec [ModifyDBSnapshot]
ReadPrec ModifyDBSnapshot
Int -> ReadS ModifyDBSnapshot
ReadS [ModifyDBSnapshot]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyDBSnapshot]
$creadListPrec :: ReadPrec [ModifyDBSnapshot]
readPrec :: ReadPrec ModifyDBSnapshot
$creadPrec :: ReadPrec ModifyDBSnapshot
readList :: ReadS [ModifyDBSnapshot]
$creadList :: ReadS [ModifyDBSnapshot]
readsPrec :: Int -> ReadS ModifyDBSnapshot
$creadsPrec :: Int -> ReadS ModifyDBSnapshot
Prelude.Read, Int -> ModifyDBSnapshot -> ShowS
[ModifyDBSnapshot] -> ShowS
ModifyDBSnapshot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyDBSnapshot] -> ShowS
$cshowList :: [ModifyDBSnapshot] -> ShowS
show :: ModifyDBSnapshot -> String
$cshow :: ModifyDBSnapshot -> String
showsPrec :: Int -> ModifyDBSnapshot -> ShowS
$cshowsPrec :: Int -> ModifyDBSnapshot -> ShowS
Prelude.Show, forall x. Rep ModifyDBSnapshot x -> ModifyDBSnapshot
forall x. ModifyDBSnapshot -> Rep ModifyDBSnapshot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifyDBSnapshot x -> ModifyDBSnapshot
$cfrom :: forall x. ModifyDBSnapshot -> Rep ModifyDBSnapshot x
Prelude.Generic)

-- |
-- Create a value of 'ModifyDBSnapshot' 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:
--
-- 'engineVersion', 'modifyDBSnapshot_engineVersion' - The engine version to upgrade the DB snapshot to.
--
-- The following are the database engines and engine versions that are
-- available when you upgrade a DB snapshot.
--
-- __MySQL__
--
-- -   @5.5.46@ (supported for 5.1 DB snapshots)
--
-- __Oracle__
--
-- -   @12.1.0.2.v8@ (supported for 12.1.0.1 DB snapshots)
--
-- -   @11.2.0.4.v12@ (supported for 11.2.0.2 DB snapshots)
--
-- -   @11.2.0.4.v11@ (supported for 11.2.0.3 DB snapshots)
--
-- __PostgreSQL__
--
-- For the list of engine versions that are available for upgrading a DB
-- snapshot, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/USER_UpgradeDBInstance.PostgreSQL.html#USER_UpgradeDBInstance.PostgreSQL.MajorVersion Upgrading the PostgreSQL DB Engine for Amazon RDS>.
--
-- 'optionGroupName', 'modifyDBSnapshot_optionGroupName' - The option group to identify with the upgraded DB snapshot.
--
-- You can specify this parameter when you upgrade an Oracle DB snapshot.
-- The same option group considerations apply when upgrading a DB snapshot
-- as when upgrading a DB instance. For more information, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/USER_UpgradeDBInstance.Oracle.html#USER_UpgradeDBInstance.Oracle.OGPG.OG Option group considerations>
-- in the /Amazon RDS User Guide./
--
-- 'dbSnapshotIdentifier', 'modifyDBSnapshot_dbSnapshotIdentifier' - The identifier of the DB snapshot to modify.
newModifyDBSnapshot ::
  -- | 'dbSnapshotIdentifier'
  Prelude.Text ->
  ModifyDBSnapshot
newModifyDBSnapshot :: Text -> ModifyDBSnapshot
newModifyDBSnapshot Text
pDBSnapshotIdentifier_ =
  ModifyDBSnapshot'
    { $sel:engineVersion:ModifyDBSnapshot' :: Maybe Text
engineVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:optionGroupName:ModifyDBSnapshot' :: Maybe Text
optionGroupName = forall a. Maybe a
Prelude.Nothing,
      $sel:dbSnapshotIdentifier:ModifyDBSnapshot' :: Text
dbSnapshotIdentifier = Text
pDBSnapshotIdentifier_
    }

-- | The engine version to upgrade the DB snapshot to.
--
-- The following are the database engines and engine versions that are
-- available when you upgrade a DB snapshot.
--
-- __MySQL__
--
-- -   @5.5.46@ (supported for 5.1 DB snapshots)
--
-- __Oracle__
--
-- -   @12.1.0.2.v8@ (supported for 12.1.0.1 DB snapshots)
--
-- -   @11.2.0.4.v12@ (supported for 11.2.0.2 DB snapshots)
--
-- -   @11.2.0.4.v11@ (supported for 11.2.0.3 DB snapshots)
--
-- __PostgreSQL__
--
-- For the list of engine versions that are available for upgrading a DB
-- snapshot, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/USER_UpgradeDBInstance.PostgreSQL.html#USER_UpgradeDBInstance.PostgreSQL.MajorVersion Upgrading the PostgreSQL DB Engine for Amazon RDS>.
modifyDBSnapshot_engineVersion :: Lens.Lens' ModifyDBSnapshot (Prelude.Maybe Prelude.Text)
modifyDBSnapshot_engineVersion :: Lens' ModifyDBSnapshot (Maybe Text)
modifyDBSnapshot_engineVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBSnapshot' {Maybe Text
engineVersion :: Maybe Text
$sel:engineVersion:ModifyDBSnapshot' :: ModifyDBSnapshot -> Maybe Text
engineVersion} -> Maybe Text
engineVersion) (\s :: ModifyDBSnapshot
s@ModifyDBSnapshot' {} Maybe Text
a -> ModifyDBSnapshot
s {$sel:engineVersion:ModifyDBSnapshot' :: Maybe Text
engineVersion = Maybe Text
a} :: ModifyDBSnapshot)

-- | The option group to identify with the upgraded DB snapshot.
--
-- You can specify this parameter when you upgrade an Oracle DB snapshot.
-- The same option group considerations apply when upgrading a DB snapshot
-- as when upgrading a DB instance. For more information, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/USER_UpgradeDBInstance.Oracle.html#USER_UpgradeDBInstance.Oracle.OGPG.OG Option group considerations>
-- in the /Amazon RDS User Guide./
modifyDBSnapshot_optionGroupName :: Lens.Lens' ModifyDBSnapshot (Prelude.Maybe Prelude.Text)
modifyDBSnapshot_optionGroupName :: Lens' ModifyDBSnapshot (Maybe Text)
modifyDBSnapshot_optionGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBSnapshot' {Maybe Text
optionGroupName :: Maybe Text
$sel:optionGroupName:ModifyDBSnapshot' :: ModifyDBSnapshot -> Maybe Text
optionGroupName} -> Maybe Text
optionGroupName) (\s :: ModifyDBSnapshot
s@ModifyDBSnapshot' {} Maybe Text
a -> ModifyDBSnapshot
s {$sel:optionGroupName:ModifyDBSnapshot' :: Maybe Text
optionGroupName = Maybe Text
a} :: ModifyDBSnapshot)

-- | The identifier of the DB snapshot to modify.
modifyDBSnapshot_dbSnapshotIdentifier :: Lens.Lens' ModifyDBSnapshot Prelude.Text
modifyDBSnapshot_dbSnapshotIdentifier :: Lens' ModifyDBSnapshot Text
modifyDBSnapshot_dbSnapshotIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBSnapshot' {Text
dbSnapshotIdentifier :: Text
$sel:dbSnapshotIdentifier:ModifyDBSnapshot' :: ModifyDBSnapshot -> Text
dbSnapshotIdentifier} -> Text
dbSnapshotIdentifier) (\s :: ModifyDBSnapshot
s@ModifyDBSnapshot' {} Text
a -> ModifyDBSnapshot
s {$sel:dbSnapshotIdentifier:ModifyDBSnapshot' :: Text
dbSnapshotIdentifier = Text
a} :: ModifyDBSnapshot)

instance Core.AWSRequest ModifyDBSnapshot where
  type
    AWSResponse ModifyDBSnapshot =
      ModifyDBSnapshotResponse
  request :: (Service -> Service)
-> ModifyDBSnapshot -> Request ModifyDBSnapshot
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ModifyDBSnapshot
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ModifyDBSnapshot)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"ModifyDBSnapshotResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe DBSnapshot -> Int -> ModifyDBSnapshotResponse
ModifyDBSnapshotResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"DBSnapshot")
            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 ModifyDBSnapshot where
  hashWithSalt :: Int -> ModifyDBSnapshot -> Int
hashWithSalt Int
_salt ModifyDBSnapshot' {Maybe Text
Text
dbSnapshotIdentifier :: Text
optionGroupName :: Maybe Text
engineVersion :: Maybe Text
$sel:dbSnapshotIdentifier:ModifyDBSnapshot' :: ModifyDBSnapshot -> Text
$sel:optionGroupName:ModifyDBSnapshot' :: ModifyDBSnapshot -> Maybe Text
$sel:engineVersion:ModifyDBSnapshot' :: ModifyDBSnapshot -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
engineVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
optionGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dbSnapshotIdentifier

instance Prelude.NFData ModifyDBSnapshot where
  rnf :: ModifyDBSnapshot -> ()
rnf ModifyDBSnapshot' {Maybe Text
Text
dbSnapshotIdentifier :: Text
optionGroupName :: Maybe Text
engineVersion :: Maybe Text
$sel:dbSnapshotIdentifier:ModifyDBSnapshot' :: ModifyDBSnapshot -> Text
$sel:optionGroupName:ModifyDBSnapshot' :: ModifyDBSnapshot -> Maybe Text
$sel:engineVersion:ModifyDBSnapshot' :: ModifyDBSnapshot -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
engineVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
optionGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dbSnapshotIdentifier

instance Data.ToHeaders ModifyDBSnapshot where
  toHeaders :: ModifyDBSnapshot -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery ModifyDBSnapshot where
  toQuery :: ModifyDBSnapshot -> QueryString
toQuery ModifyDBSnapshot' {Maybe Text
Text
dbSnapshotIdentifier :: Text
optionGroupName :: Maybe Text
engineVersion :: Maybe Text
$sel:dbSnapshotIdentifier:ModifyDBSnapshot' :: ModifyDBSnapshot -> Text
$sel:optionGroupName:ModifyDBSnapshot' :: ModifyDBSnapshot -> Maybe Text
$sel:engineVersion:ModifyDBSnapshot' :: ModifyDBSnapshot -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ModifyDBSnapshot" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"EngineVersion" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
engineVersion,
        ByteString
"OptionGroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
optionGroupName,
        ByteString
"DBSnapshotIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
dbSnapshotIdentifier
      ]

-- | /See:/ 'newModifyDBSnapshotResponse' smart constructor.
data ModifyDBSnapshotResponse = ModifyDBSnapshotResponse'
  { ModifyDBSnapshotResponse -> Maybe DBSnapshot
dbSnapshot :: Prelude.Maybe DBSnapshot,
    -- | The response's http status code.
    ModifyDBSnapshotResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ModifyDBSnapshotResponse -> ModifyDBSnapshotResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyDBSnapshotResponse -> ModifyDBSnapshotResponse -> Bool
$c/= :: ModifyDBSnapshotResponse -> ModifyDBSnapshotResponse -> Bool
== :: ModifyDBSnapshotResponse -> ModifyDBSnapshotResponse -> Bool
$c== :: ModifyDBSnapshotResponse -> ModifyDBSnapshotResponse -> Bool
Prelude.Eq, ReadPrec [ModifyDBSnapshotResponse]
ReadPrec ModifyDBSnapshotResponse
Int -> ReadS ModifyDBSnapshotResponse
ReadS [ModifyDBSnapshotResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyDBSnapshotResponse]
$creadListPrec :: ReadPrec [ModifyDBSnapshotResponse]
readPrec :: ReadPrec ModifyDBSnapshotResponse
$creadPrec :: ReadPrec ModifyDBSnapshotResponse
readList :: ReadS [ModifyDBSnapshotResponse]
$creadList :: ReadS [ModifyDBSnapshotResponse]
readsPrec :: Int -> ReadS ModifyDBSnapshotResponse
$creadsPrec :: Int -> ReadS ModifyDBSnapshotResponse
Prelude.Read, Int -> ModifyDBSnapshotResponse -> ShowS
[ModifyDBSnapshotResponse] -> ShowS
ModifyDBSnapshotResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyDBSnapshotResponse] -> ShowS
$cshowList :: [ModifyDBSnapshotResponse] -> ShowS
show :: ModifyDBSnapshotResponse -> String
$cshow :: ModifyDBSnapshotResponse -> String
showsPrec :: Int -> ModifyDBSnapshotResponse -> ShowS
$cshowsPrec :: Int -> ModifyDBSnapshotResponse -> ShowS
Prelude.Show, forall x.
Rep ModifyDBSnapshotResponse x -> ModifyDBSnapshotResponse
forall x.
ModifyDBSnapshotResponse -> Rep ModifyDBSnapshotResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ModifyDBSnapshotResponse x -> ModifyDBSnapshotResponse
$cfrom :: forall x.
ModifyDBSnapshotResponse -> Rep ModifyDBSnapshotResponse x
Prelude.Generic)

-- |
-- Create a value of 'ModifyDBSnapshotResponse' 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:
--
-- 'dbSnapshot', 'modifyDBSnapshotResponse_dbSnapshot' - Undocumented member.
--
-- 'httpStatus', 'modifyDBSnapshotResponse_httpStatus' - The response's http status code.
newModifyDBSnapshotResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ModifyDBSnapshotResponse
newModifyDBSnapshotResponse :: Int -> ModifyDBSnapshotResponse
newModifyDBSnapshotResponse Int
pHttpStatus_ =
  ModifyDBSnapshotResponse'
    { $sel:dbSnapshot:ModifyDBSnapshotResponse' :: Maybe DBSnapshot
dbSnapshot =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ModifyDBSnapshotResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
modifyDBSnapshotResponse_dbSnapshot :: Lens.Lens' ModifyDBSnapshotResponse (Prelude.Maybe DBSnapshot)
modifyDBSnapshotResponse_dbSnapshot :: Lens' ModifyDBSnapshotResponse (Maybe DBSnapshot)
modifyDBSnapshotResponse_dbSnapshot = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyDBSnapshotResponse' {Maybe DBSnapshot
dbSnapshot :: Maybe DBSnapshot
$sel:dbSnapshot:ModifyDBSnapshotResponse' :: ModifyDBSnapshotResponse -> Maybe DBSnapshot
dbSnapshot} -> Maybe DBSnapshot
dbSnapshot) (\s :: ModifyDBSnapshotResponse
s@ModifyDBSnapshotResponse' {} Maybe DBSnapshot
a -> ModifyDBSnapshotResponse
s {$sel:dbSnapshot:ModifyDBSnapshotResponse' :: Maybe DBSnapshot
dbSnapshot = Maybe DBSnapshot
a} :: ModifyDBSnapshotResponse)

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

instance Prelude.NFData ModifyDBSnapshotResponse where
  rnf :: ModifyDBSnapshotResponse -> ()
rnf ModifyDBSnapshotResponse' {Int
Maybe DBSnapshot
httpStatus :: Int
dbSnapshot :: Maybe DBSnapshot
$sel:httpStatus:ModifyDBSnapshotResponse' :: ModifyDBSnapshotResponse -> Int
$sel:dbSnapshot:ModifyDBSnapshotResponse' :: ModifyDBSnapshotResponse -> Maybe DBSnapshot
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DBSnapshot
dbSnapshot
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus