{-# 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.Neptune.RestoreDBClusterToPointInTime
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Restores a DB cluster to an arbitrary point in time. Users can restore
-- to any point in time before @LatestRestorableTime@ for up to
-- @BackupRetentionPeriod@ days. The target DB cluster is created from the
-- source DB cluster with the same configuration as the original DB
-- cluster, except that the new DB cluster is created with the default DB
-- security group.
--
-- This action only restores the DB cluster, not the DB instances for that
-- DB cluster. You must invoke the CreateDBInstance action to create DB
-- instances for the restored DB cluster, specifying the identifier of the
-- restored DB cluster in @DBClusterIdentifier@. You can create DB
-- instances only after the @RestoreDBClusterToPointInTime@ action has
-- completed and the DB cluster is available.
module Amazonka.Neptune.RestoreDBClusterToPointInTime
  ( -- * Creating a Request
    RestoreDBClusterToPointInTime (..),
    newRestoreDBClusterToPointInTime,

    -- * Request Lenses
    restoreDBClusterToPointInTime_dbClusterParameterGroupName,
    restoreDBClusterToPointInTime_dbSubnetGroupName,
    restoreDBClusterToPointInTime_deletionProtection,
    restoreDBClusterToPointInTime_enableCloudwatchLogsExports,
    restoreDBClusterToPointInTime_enableIAMDatabaseAuthentication,
    restoreDBClusterToPointInTime_kmsKeyId,
    restoreDBClusterToPointInTime_optionGroupName,
    restoreDBClusterToPointInTime_port,
    restoreDBClusterToPointInTime_restoreToTime,
    restoreDBClusterToPointInTime_restoreType,
    restoreDBClusterToPointInTime_serverlessV2ScalingConfiguration,
    restoreDBClusterToPointInTime_tags,
    restoreDBClusterToPointInTime_useLatestRestorableTime,
    restoreDBClusterToPointInTime_vpcSecurityGroupIds,
    restoreDBClusterToPointInTime_dbClusterIdentifier,
    restoreDBClusterToPointInTime_sourceDBClusterIdentifier,

    -- * Destructuring the Response
    RestoreDBClusterToPointInTimeResponse (..),
    newRestoreDBClusterToPointInTimeResponse,

    -- * Response Lenses
    restoreDBClusterToPointInTimeResponse_dbCluster,
    restoreDBClusterToPointInTimeResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Neptune.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newRestoreDBClusterToPointInTime' smart constructor.
data RestoreDBClusterToPointInTime = RestoreDBClusterToPointInTime'
  { -- | The name of the DB cluster parameter group to associate with the new DB
    -- cluster.
    --
    -- Constraints:
    --
    -- -   If supplied, must match the name of an existing
    --     DBClusterParameterGroup.
    RestoreDBClusterToPointInTime -> Maybe Text
dbClusterParameterGroupName :: Prelude.Maybe Prelude.Text,
    -- | The DB subnet group name to use for the new DB cluster.
    --
    -- Constraints: If supplied, must match the name of an existing
    -- DBSubnetGroup.
    --
    -- Example: @mySubnetgroup@
    RestoreDBClusterToPointInTime -> Maybe Text
dbSubnetGroupName :: Prelude.Maybe Prelude.Text,
    -- | A value that indicates whether the DB cluster has deletion protection
    -- enabled. The database can\'t be deleted when deletion protection is
    -- enabled. By default, deletion protection is disabled.
    RestoreDBClusterToPointInTime -> Maybe Bool
deletionProtection :: Prelude.Maybe Prelude.Bool,
    -- | The list of logs that the restored DB cluster is to export to CloudWatch
    -- Logs.
    RestoreDBClusterToPointInTime -> Maybe [Text]
enableCloudwatchLogsExports :: Prelude.Maybe [Prelude.Text],
    -- | True to enable mapping of Amazon Identity and Access Management (IAM)
    -- accounts to database accounts, and otherwise false.
    --
    -- Default: @false@
    RestoreDBClusterToPointInTime -> Maybe Bool
enableIAMDatabaseAuthentication :: Prelude.Maybe Prelude.Bool,
    -- | The Amazon KMS key identifier to use when restoring an encrypted DB
    -- cluster from an encrypted DB cluster.
    --
    -- The KMS key identifier is the Amazon Resource Name (ARN) for the KMS
    -- encryption key. If you are restoring a DB cluster with the same Amazon
    -- account that owns the KMS encryption key used to encrypt the new DB
    -- cluster, then you can use the KMS key alias instead of the ARN for the
    -- KMS encryption key.
    --
    -- You can restore to a new DB cluster and encrypt the new DB cluster with
    -- a KMS key that is different than the KMS key used to encrypt the source
    -- DB cluster. The new DB cluster is encrypted with the KMS key identified
    -- by the @KmsKeyId@ parameter.
    --
    -- If you do not specify a value for the @KmsKeyId@ parameter, then the
    -- following will occur:
    --
    -- -   If the DB cluster is encrypted, then the restored DB cluster is
    --     encrypted using the KMS key that was used to encrypt the source DB
    --     cluster.
    --
    -- -   If the DB cluster is not encrypted, then the restored DB cluster is
    --     not encrypted.
    --
    -- If @DBClusterIdentifier@ refers to a DB cluster that is not encrypted,
    -- then the restore request is rejected.
    RestoreDBClusterToPointInTime -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | /(Not supported by Neptune)/
    RestoreDBClusterToPointInTime -> Maybe Text
optionGroupName :: Prelude.Maybe Prelude.Text,
    -- | The port number on which the new DB cluster accepts connections.
    --
    -- Constraints: Value must be @1150-65535@
    --
    -- Default: The same port as the original DB cluster.
    RestoreDBClusterToPointInTime -> Maybe Int
port :: Prelude.Maybe Prelude.Int,
    -- | The date and time to restore the DB cluster to.
    --
    -- Valid Values: Value must be a time in Universal Coordinated Time (UTC)
    -- format
    --
    -- Constraints:
    --
    -- -   Must be before the latest restorable time for the DB instance
    --
    -- -   Must be specified if @UseLatestRestorableTime@ parameter is not
    --     provided
    --
    -- -   Cannot be specified if @UseLatestRestorableTime@ parameter is true
    --
    -- -   Cannot be specified if @RestoreType@ parameter is @copy-on-write@
    --
    -- Example: @2015-03-07T23:45:00Z@
    RestoreDBClusterToPointInTime -> Maybe ISO8601
restoreToTime :: Prelude.Maybe Data.ISO8601,
    -- | The type of restore to be performed. You can specify one of the
    -- following values:
    --
    -- -   @full-copy@ - The new DB cluster is restored as a full copy of the
    --     source DB cluster.
    --
    -- -   @copy-on-write@ - The new DB cluster is restored as a clone of the
    --     source DB cluster.
    --
    -- If you don\'t specify a @RestoreType@ value, then the new DB cluster is
    -- restored as a full copy of the source DB cluster.
    RestoreDBClusterToPointInTime -> Maybe Text
restoreType :: Prelude.Maybe Prelude.Text,
    RestoreDBClusterToPointInTime
-> Maybe ServerlessV2ScalingConfiguration
serverlessV2ScalingConfiguration :: Prelude.Maybe ServerlessV2ScalingConfiguration,
    -- | The tags to be applied to the restored DB cluster.
    RestoreDBClusterToPointInTime -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | A value that is set to @true@ to restore the DB cluster to the latest
    -- restorable backup time, and @false@ otherwise.
    --
    -- Default: @false@
    --
    -- Constraints: Cannot be specified if @RestoreToTime@ parameter is
    -- provided.
    RestoreDBClusterToPointInTime -> Maybe Bool
useLatestRestorableTime :: Prelude.Maybe Prelude.Bool,
    -- | A list of VPC security groups that the new DB cluster belongs to.
    RestoreDBClusterToPointInTime -> Maybe [Text]
vpcSecurityGroupIds :: Prelude.Maybe [Prelude.Text],
    -- | The name of the new DB cluster to be created.
    --
    -- Constraints:
    --
    -- -   Must contain from 1 to 63 letters, numbers, or hyphens
    --
    -- -   First character must be a letter
    --
    -- -   Cannot end with a hyphen or contain two consecutive hyphens
    RestoreDBClusterToPointInTime -> Text
dbClusterIdentifier :: Prelude.Text,
    -- | The identifier of the source DB cluster from which to restore.
    --
    -- Constraints:
    --
    -- -   Must match the identifier of an existing DBCluster.
    RestoreDBClusterToPointInTime -> Text
sourceDBClusterIdentifier :: Prelude.Text
  }
  deriving (RestoreDBClusterToPointInTime
-> RestoreDBClusterToPointInTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RestoreDBClusterToPointInTime
-> RestoreDBClusterToPointInTime -> Bool
$c/= :: RestoreDBClusterToPointInTime
-> RestoreDBClusterToPointInTime -> Bool
== :: RestoreDBClusterToPointInTime
-> RestoreDBClusterToPointInTime -> Bool
$c== :: RestoreDBClusterToPointInTime
-> RestoreDBClusterToPointInTime -> Bool
Prelude.Eq, ReadPrec [RestoreDBClusterToPointInTime]
ReadPrec RestoreDBClusterToPointInTime
Int -> ReadS RestoreDBClusterToPointInTime
ReadS [RestoreDBClusterToPointInTime]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RestoreDBClusterToPointInTime]
$creadListPrec :: ReadPrec [RestoreDBClusterToPointInTime]
readPrec :: ReadPrec RestoreDBClusterToPointInTime
$creadPrec :: ReadPrec RestoreDBClusterToPointInTime
readList :: ReadS [RestoreDBClusterToPointInTime]
$creadList :: ReadS [RestoreDBClusterToPointInTime]
readsPrec :: Int -> ReadS RestoreDBClusterToPointInTime
$creadsPrec :: Int -> ReadS RestoreDBClusterToPointInTime
Prelude.Read, Int -> RestoreDBClusterToPointInTime -> ShowS
[RestoreDBClusterToPointInTime] -> ShowS
RestoreDBClusterToPointInTime -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RestoreDBClusterToPointInTime] -> ShowS
$cshowList :: [RestoreDBClusterToPointInTime] -> ShowS
show :: RestoreDBClusterToPointInTime -> String
$cshow :: RestoreDBClusterToPointInTime -> String
showsPrec :: Int -> RestoreDBClusterToPointInTime -> ShowS
$cshowsPrec :: Int -> RestoreDBClusterToPointInTime -> ShowS
Prelude.Show, forall x.
Rep RestoreDBClusterToPointInTime x
-> RestoreDBClusterToPointInTime
forall x.
RestoreDBClusterToPointInTime
-> Rep RestoreDBClusterToPointInTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RestoreDBClusterToPointInTime x
-> RestoreDBClusterToPointInTime
$cfrom :: forall x.
RestoreDBClusterToPointInTime
-> Rep RestoreDBClusterToPointInTime x
Prelude.Generic)

-- |
-- Create a value of 'RestoreDBClusterToPointInTime' 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:
--
-- 'dbClusterParameterGroupName', 'restoreDBClusterToPointInTime_dbClusterParameterGroupName' - The name of the DB cluster parameter group to associate with the new DB
-- cluster.
--
-- Constraints:
--
-- -   If supplied, must match the name of an existing
--     DBClusterParameterGroup.
--
-- 'dbSubnetGroupName', 'restoreDBClusterToPointInTime_dbSubnetGroupName' - The DB subnet group name to use for the new DB cluster.
--
-- Constraints: If supplied, must match the name of an existing
-- DBSubnetGroup.
--
-- Example: @mySubnetgroup@
--
-- 'deletionProtection', 'restoreDBClusterToPointInTime_deletionProtection' - A value that indicates whether the DB cluster has deletion protection
-- enabled. The database can\'t be deleted when deletion protection is
-- enabled. By default, deletion protection is disabled.
--
-- 'enableCloudwatchLogsExports', 'restoreDBClusterToPointInTime_enableCloudwatchLogsExports' - The list of logs that the restored DB cluster is to export to CloudWatch
-- Logs.
--
-- 'enableIAMDatabaseAuthentication', 'restoreDBClusterToPointInTime_enableIAMDatabaseAuthentication' - True to enable mapping of Amazon Identity and Access Management (IAM)
-- accounts to database accounts, and otherwise false.
--
-- Default: @false@
--
-- 'kmsKeyId', 'restoreDBClusterToPointInTime_kmsKeyId' - The Amazon KMS key identifier to use when restoring an encrypted DB
-- cluster from an encrypted DB cluster.
--
-- The KMS key identifier is the Amazon Resource Name (ARN) for the KMS
-- encryption key. If you are restoring a DB cluster with the same Amazon
-- account that owns the KMS encryption key used to encrypt the new DB
-- cluster, then you can use the KMS key alias instead of the ARN for the
-- KMS encryption key.
--
-- You can restore to a new DB cluster and encrypt the new DB cluster with
-- a KMS key that is different than the KMS key used to encrypt the source
-- DB cluster. The new DB cluster is encrypted with the KMS key identified
-- by the @KmsKeyId@ parameter.
--
-- If you do not specify a value for the @KmsKeyId@ parameter, then the
-- following will occur:
--
-- -   If the DB cluster is encrypted, then the restored DB cluster is
--     encrypted using the KMS key that was used to encrypt the source DB
--     cluster.
--
-- -   If the DB cluster is not encrypted, then the restored DB cluster is
--     not encrypted.
--
-- If @DBClusterIdentifier@ refers to a DB cluster that is not encrypted,
-- then the restore request is rejected.
--
-- 'optionGroupName', 'restoreDBClusterToPointInTime_optionGroupName' - /(Not supported by Neptune)/
--
-- 'port', 'restoreDBClusterToPointInTime_port' - The port number on which the new DB cluster accepts connections.
--
-- Constraints: Value must be @1150-65535@
--
-- Default: The same port as the original DB cluster.
--
-- 'restoreToTime', 'restoreDBClusterToPointInTime_restoreToTime' - The date and time to restore the DB cluster to.
--
-- Valid Values: Value must be a time in Universal Coordinated Time (UTC)
-- format
--
-- Constraints:
--
-- -   Must be before the latest restorable time for the DB instance
--
-- -   Must be specified if @UseLatestRestorableTime@ parameter is not
--     provided
--
-- -   Cannot be specified if @UseLatestRestorableTime@ parameter is true
--
-- -   Cannot be specified if @RestoreType@ parameter is @copy-on-write@
--
-- Example: @2015-03-07T23:45:00Z@
--
-- 'restoreType', 'restoreDBClusterToPointInTime_restoreType' - The type of restore to be performed. You can specify one of the
-- following values:
--
-- -   @full-copy@ - The new DB cluster is restored as a full copy of the
--     source DB cluster.
--
-- -   @copy-on-write@ - The new DB cluster is restored as a clone of the
--     source DB cluster.
--
-- If you don\'t specify a @RestoreType@ value, then the new DB cluster is
-- restored as a full copy of the source DB cluster.
--
-- 'serverlessV2ScalingConfiguration', 'restoreDBClusterToPointInTime_serverlessV2ScalingConfiguration' - Undocumented member.
--
-- 'tags', 'restoreDBClusterToPointInTime_tags' - The tags to be applied to the restored DB cluster.
--
-- 'useLatestRestorableTime', 'restoreDBClusterToPointInTime_useLatestRestorableTime' - A value that is set to @true@ to restore the DB cluster to the latest
-- restorable backup time, and @false@ otherwise.
--
-- Default: @false@
--
-- Constraints: Cannot be specified if @RestoreToTime@ parameter is
-- provided.
--
-- 'vpcSecurityGroupIds', 'restoreDBClusterToPointInTime_vpcSecurityGroupIds' - A list of VPC security groups that the new DB cluster belongs to.
--
-- 'dbClusterIdentifier', 'restoreDBClusterToPointInTime_dbClusterIdentifier' - The name of the new DB cluster to be created.
--
-- Constraints:
--
-- -   Must contain from 1 to 63 letters, numbers, or hyphens
--
-- -   First character must be a letter
--
-- -   Cannot end with a hyphen or contain two consecutive hyphens
--
-- 'sourceDBClusterIdentifier', 'restoreDBClusterToPointInTime_sourceDBClusterIdentifier' - The identifier of the source DB cluster from which to restore.
--
-- Constraints:
--
-- -   Must match the identifier of an existing DBCluster.
newRestoreDBClusterToPointInTime ::
  -- | 'dbClusterIdentifier'
  Prelude.Text ->
  -- | 'sourceDBClusterIdentifier'
  Prelude.Text ->
  RestoreDBClusterToPointInTime
newRestoreDBClusterToPointInTime :: Text -> Text -> RestoreDBClusterToPointInTime
newRestoreDBClusterToPointInTime
  Text
pDBClusterIdentifier_
  Text
pSourceDBClusterIdentifier_ =
    RestoreDBClusterToPointInTime'
      { $sel:dbClusterParameterGroupName:RestoreDBClusterToPointInTime' :: Maybe Text
dbClusterParameterGroupName =
          forall a. Maybe a
Prelude.Nothing,
        $sel:dbSubnetGroupName:RestoreDBClusterToPointInTime' :: Maybe Text
dbSubnetGroupName = forall a. Maybe a
Prelude.Nothing,
        $sel:deletionProtection:RestoreDBClusterToPointInTime' :: Maybe Bool
deletionProtection = forall a. Maybe a
Prelude.Nothing,
        $sel:enableCloudwatchLogsExports:RestoreDBClusterToPointInTime' :: Maybe [Text]
enableCloudwatchLogsExports =
          forall a. Maybe a
Prelude.Nothing,
        $sel:enableIAMDatabaseAuthentication:RestoreDBClusterToPointInTime' :: Maybe Bool
enableIAMDatabaseAuthentication =
          forall a. Maybe a
Prelude.Nothing,
        $sel:kmsKeyId:RestoreDBClusterToPointInTime' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
        $sel:optionGroupName:RestoreDBClusterToPointInTime' :: Maybe Text
optionGroupName = forall a. Maybe a
Prelude.Nothing,
        $sel:port:RestoreDBClusterToPointInTime' :: Maybe Int
port = forall a. Maybe a
Prelude.Nothing,
        $sel:restoreToTime:RestoreDBClusterToPointInTime' :: Maybe ISO8601
restoreToTime = forall a. Maybe a
Prelude.Nothing,
        $sel:restoreType:RestoreDBClusterToPointInTime' :: Maybe Text
restoreType = forall a. Maybe a
Prelude.Nothing,
        $sel:serverlessV2ScalingConfiguration:RestoreDBClusterToPointInTime' :: Maybe ServerlessV2ScalingConfiguration
serverlessV2ScalingConfiguration =
          forall a. Maybe a
Prelude.Nothing,
        $sel:tags:RestoreDBClusterToPointInTime' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:useLatestRestorableTime:RestoreDBClusterToPointInTime' :: Maybe Bool
useLatestRestorableTime = forall a. Maybe a
Prelude.Nothing,
        $sel:vpcSecurityGroupIds:RestoreDBClusterToPointInTime' :: Maybe [Text]
vpcSecurityGroupIds = forall a. Maybe a
Prelude.Nothing,
        $sel:dbClusterIdentifier:RestoreDBClusterToPointInTime' :: Text
dbClusterIdentifier = Text
pDBClusterIdentifier_,
        $sel:sourceDBClusterIdentifier:RestoreDBClusterToPointInTime' :: Text
sourceDBClusterIdentifier =
          Text
pSourceDBClusterIdentifier_
      }

-- | The name of the DB cluster parameter group to associate with the new DB
-- cluster.
--
-- Constraints:
--
-- -   If supplied, must match the name of an existing
--     DBClusterParameterGroup.
restoreDBClusterToPointInTime_dbClusterParameterGroupName :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.Text)
restoreDBClusterToPointInTime_dbClusterParameterGroupName :: Lens' RestoreDBClusterToPointInTime (Maybe Text)
restoreDBClusterToPointInTime_dbClusterParameterGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe Text
dbClusterParameterGroupName :: Maybe Text
$sel:dbClusterParameterGroupName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
dbClusterParameterGroupName} -> Maybe Text
dbClusterParameterGroupName) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe Text
a -> RestoreDBClusterToPointInTime
s {$sel:dbClusterParameterGroupName:RestoreDBClusterToPointInTime' :: Maybe Text
dbClusterParameterGroupName = Maybe Text
a} :: RestoreDBClusterToPointInTime)

-- | The DB subnet group name to use for the new DB cluster.
--
-- Constraints: If supplied, must match the name of an existing
-- DBSubnetGroup.
--
-- Example: @mySubnetgroup@
restoreDBClusterToPointInTime_dbSubnetGroupName :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.Text)
restoreDBClusterToPointInTime_dbSubnetGroupName :: Lens' RestoreDBClusterToPointInTime (Maybe Text)
restoreDBClusterToPointInTime_dbSubnetGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe Text
dbSubnetGroupName :: Maybe Text
$sel:dbSubnetGroupName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
dbSubnetGroupName} -> Maybe Text
dbSubnetGroupName) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe Text
a -> RestoreDBClusterToPointInTime
s {$sel:dbSubnetGroupName:RestoreDBClusterToPointInTime' :: Maybe Text
dbSubnetGroupName = Maybe Text
a} :: RestoreDBClusterToPointInTime)

-- | A value that indicates whether the DB cluster has deletion protection
-- enabled. The database can\'t be deleted when deletion protection is
-- enabled. By default, deletion protection is disabled.
restoreDBClusterToPointInTime_deletionProtection :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.Bool)
restoreDBClusterToPointInTime_deletionProtection :: Lens' RestoreDBClusterToPointInTime (Maybe Bool)
restoreDBClusterToPointInTime_deletionProtection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe Bool
deletionProtection :: Maybe Bool
$sel:deletionProtection:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
deletionProtection} -> Maybe Bool
deletionProtection) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe Bool
a -> RestoreDBClusterToPointInTime
s {$sel:deletionProtection:RestoreDBClusterToPointInTime' :: Maybe Bool
deletionProtection = Maybe Bool
a} :: RestoreDBClusterToPointInTime)

-- | The list of logs that the restored DB cluster is to export to CloudWatch
-- Logs.
restoreDBClusterToPointInTime_enableCloudwatchLogsExports :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe [Prelude.Text])
restoreDBClusterToPointInTime_enableCloudwatchLogsExports :: Lens' RestoreDBClusterToPointInTime (Maybe [Text])
restoreDBClusterToPointInTime_enableCloudwatchLogsExports = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe [Text]
enableCloudwatchLogsExports :: Maybe [Text]
$sel:enableCloudwatchLogsExports:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe [Text]
enableCloudwatchLogsExports} -> Maybe [Text]
enableCloudwatchLogsExports) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe [Text]
a -> RestoreDBClusterToPointInTime
s {$sel:enableCloudwatchLogsExports:RestoreDBClusterToPointInTime' :: Maybe [Text]
enableCloudwatchLogsExports = Maybe [Text]
a} :: RestoreDBClusterToPointInTime) 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

-- | True to enable mapping of Amazon Identity and Access Management (IAM)
-- accounts to database accounts, and otherwise false.
--
-- Default: @false@
restoreDBClusterToPointInTime_enableIAMDatabaseAuthentication :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.Bool)
restoreDBClusterToPointInTime_enableIAMDatabaseAuthentication :: Lens' RestoreDBClusterToPointInTime (Maybe Bool)
restoreDBClusterToPointInTime_enableIAMDatabaseAuthentication = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe Bool
enableIAMDatabaseAuthentication :: Maybe Bool
$sel:enableIAMDatabaseAuthentication:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
enableIAMDatabaseAuthentication} -> Maybe Bool
enableIAMDatabaseAuthentication) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe Bool
a -> RestoreDBClusterToPointInTime
s {$sel:enableIAMDatabaseAuthentication:RestoreDBClusterToPointInTime' :: Maybe Bool
enableIAMDatabaseAuthentication = Maybe Bool
a} :: RestoreDBClusterToPointInTime)

-- | The Amazon KMS key identifier to use when restoring an encrypted DB
-- cluster from an encrypted DB cluster.
--
-- The KMS key identifier is the Amazon Resource Name (ARN) for the KMS
-- encryption key. If you are restoring a DB cluster with the same Amazon
-- account that owns the KMS encryption key used to encrypt the new DB
-- cluster, then you can use the KMS key alias instead of the ARN for the
-- KMS encryption key.
--
-- You can restore to a new DB cluster and encrypt the new DB cluster with
-- a KMS key that is different than the KMS key used to encrypt the source
-- DB cluster. The new DB cluster is encrypted with the KMS key identified
-- by the @KmsKeyId@ parameter.
--
-- If you do not specify a value for the @KmsKeyId@ parameter, then the
-- following will occur:
--
-- -   If the DB cluster is encrypted, then the restored DB cluster is
--     encrypted using the KMS key that was used to encrypt the source DB
--     cluster.
--
-- -   If the DB cluster is not encrypted, then the restored DB cluster is
--     not encrypted.
--
-- If @DBClusterIdentifier@ refers to a DB cluster that is not encrypted,
-- then the restore request is rejected.
restoreDBClusterToPointInTime_kmsKeyId :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.Text)
restoreDBClusterToPointInTime_kmsKeyId :: Lens' RestoreDBClusterToPointInTime (Maybe Text)
restoreDBClusterToPointInTime_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe Text
a -> RestoreDBClusterToPointInTime
s {$sel:kmsKeyId:RestoreDBClusterToPointInTime' :: Maybe Text
kmsKeyId = Maybe Text
a} :: RestoreDBClusterToPointInTime)

-- | /(Not supported by Neptune)/
restoreDBClusterToPointInTime_optionGroupName :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.Text)
restoreDBClusterToPointInTime_optionGroupName :: Lens' RestoreDBClusterToPointInTime (Maybe Text)
restoreDBClusterToPointInTime_optionGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe Text
optionGroupName :: Maybe Text
$sel:optionGroupName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
optionGroupName} -> Maybe Text
optionGroupName) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe Text
a -> RestoreDBClusterToPointInTime
s {$sel:optionGroupName:RestoreDBClusterToPointInTime' :: Maybe Text
optionGroupName = Maybe Text
a} :: RestoreDBClusterToPointInTime)

-- | The port number on which the new DB cluster accepts connections.
--
-- Constraints: Value must be @1150-65535@
--
-- Default: The same port as the original DB cluster.
restoreDBClusterToPointInTime_port :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.Int)
restoreDBClusterToPointInTime_port :: Lens' RestoreDBClusterToPointInTime (Maybe Int)
restoreDBClusterToPointInTime_port = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe Int
port :: Maybe Int
$sel:port:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Int
port} -> Maybe Int
port) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe Int
a -> RestoreDBClusterToPointInTime
s {$sel:port:RestoreDBClusterToPointInTime' :: Maybe Int
port = Maybe Int
a} :: RestoreDBClusterToPointInTime)

-- | The date and time to restore the DB cluster to.
--
-- Valid Values: Value must be a time in Universal Coordinated Time (UTC)
-- format
--
-- Constraints:
--
-- -   Must be before the latest restorable time for the DB instance
--
-- -   Must be specified if @UseLatestRestorableTime@ parameter is not
--     provided
--
-- -   Cannot be specified if @UseLatestRestorableTime@ parameter is true
--
-- -   Cannot be specified if @RestoreType@ parameter is @copy-on-write@
--
-- Example: @2015-03-07T23:45:00Z@
restoreDBClusterToPointInTime_restoreToTime :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.UTCTime)
restoreDBClusterToPointInTime_restoreToTime :: Lens' RestoreDBClusterToPointInTime (Maybe UTCTime)
restoreDBClusterToPointInTime_restoreToTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe ISO8601
restoreToTime :: Maybe ISO8601
$sel:restoreToTime:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe ISO8601
restoreToTime} -> Maybe ISO8601
restoreToTime) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe ISO8601
a -> RestoreDBClusterToPointInTime
s {$sel:restoreToTime:RestoreDBClusterToPointInTime' :: Maybe ISO8601
restoreToTime = Maybe ISO8601
a} :: RestoreDBClusterToPointInTime) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The type of restore to be performed. You can specify one of the
-- following values:
--
-- -   @full-copy@ - The new DB cluster is restored as a full copy of the
--     source DB cluster.
--
-- -   @copy-on-write@ - The new DB cluster is restored as a clone of the
--     source DB cluster.
--
-- If you don\'t specify a @RestoreType@ value, then the new DB cluster is
-- restored as a full copy of the source DB cluster.
restoreDBClusterToPointInTime_restoreType :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.Text)
restoreDBClusterToPointInTime_restoreType :: Lens' RestoreDBClusterToPointInTime (Maybe Text)
restoreDBClusterToPointInTime_restoreType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe Text
restoreType :: Maybe Text
$sel:restoreType:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
restoreType} -> Maybe Text
restoreType) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe Text
a -> RestoreDBClusterToPointInTime
s {$sel:restoreType:RestoreDBClusterToPointInTime' :: Maybe Text
restoreType = Maybe Text
a} :: RestoreDBClusterToPointInTime)

-- | Undocumented member.
restoreDBClusterToPointInTime_serverlessV2ScalingConfiguration :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe ServerlessV2ScalingConfiguration)
restoreDBClusterToPointInTime_serverlessV2ScalingConfiguration :: Lens'
  RestoreDBClusterToPointInTime
  (Maybe ServerlessV2ScalingConfiguration)
restoreDBClusterToPointInTime_serverlessV2ScalingConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe ServerlessV2ScalingConfiguration
serverlessV2ScalingConfiguration :: Maybe ServerlessV2ScalingConfiguration
$sel:serverlessV2ScalingConfiguration:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime
-> Maybe ServerlessV2ScalingConfiguration
serverlessV2ScalingConfiguration} -> Maybe ServerlessV2ScalingConfiguration
serverlessV2ScalingConfiguration) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe ServerlessV2ScalingConfiguration
a -> RestoreDBClusterToPointInTime
s {$sel:serverlessV2ScalingConfiguration:RestoreDBClusterToPointInTime' :: Maybe ServerlessV2ScalingConfiguration
serverlessV2ScalingConfiguration = Maybe ServerlessV2ScalingConfiguration
a} :: RestoreDBClusterToPointInTime)

-- | The tags to be applied to the restored DB cluster.
restoreDBClusterToPointInTime_tags :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe [Tag])
restoreDBClusterToPointInTime_tags :: Lens' RestoreDBClusterToPointInTime (Maybe [Tag])
restoreDBClusterToPointInTime_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe [Tag]
a -> RestoreDBClusterToPointInTime
s {$sel:tags:RestoreDBClusterToPointInTime' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: RestoreDBClusterToPointInTime) 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 that is set to @true@ to restore the DB cluster to the latest
-- restorable backup time, and @false@ otherwise.
--
-- Default: @false@
--
-- Constraints: Cannot be specified if @RestoreToTime@ parameter is
-- provided.
restoreDBClusterToPointInTime_useLatestRestorableTime :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe Prelude.Bool)
restoreDBClusterToPointInTime_useLatestRestorableTime :: Lens' RestoreDBClusterToPointInTime (Maybe Bool)
restoreDBClusterToPointInTime_useLatestRestorableTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe Bool
useLatestRestorableTime :: Maybe Bool
$sel:useLatestRestorableTime:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
useLatestRestorableTime} -> Maybe Bool
useLatestRestorableTime) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe Bool
a -> RestoreDBClusterToPointInTime
s {$sel:useLatestRestorableTime:RestoreDBClusterToPointInTime' :: Maybe Bool
useLatestRestorableTime = Maybe Bool
a} :: RestoreDBClusterToPointInTime)

-- | A list of VPC security groups that the new DB cluster belongs to.
restoreDBClusterToPointInTime_vpcSecurityGroupIds :: Lens.Lens' RestoreDBClusterToPointInTime (Prelude.Maybe [Prelude.Text])
restoreDBClusterToPointInTime_vpcSecurityGroupIds :: Lens' RestoreDBClusterToPointInTime (Maybe [Text])
restoreDBClusterToPointInTime_vpcSecurityGroupIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Maybe [Text]
vpcSecurityGroupIds :: Maybe [Text]
$sel:vpcSecurityGroupIds:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe [Text]
vpcSecurityGroupIds} -> Maybe [Text]
vpcSecurityGroupIds) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Maybe [Text]
a -> RestoreDBClusterToPointInTime
s {$sel:vpcSecurityGroupIds:RestoreDBClusterToPointInTime' :: Maybe [Text]
vpcSecurityGroupIds = Maybe [Text]
a} :: RestoreDBClusterToPointInTime) 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

-- | The name of the new DB cluster to be created.
--
-- Constraints:
--
-- -   Must contain from 1 to 63 letters, numbers, or hyphens
--
-- -   First character must be a letter
--
-- -   Cannot end with a hyphen or contain two consecutive hyphens
restoreDBClusterToPointInTime_dbClusterIdentifier :: Lens.Lens' RestoreDBClusterToPointInTime Prelude.Text
restoreDBClusterToPointInTime_dbClusterIdentifier :: Lens' RestoreDBClusterToPointInTime Text
restoreDBClusterToPointInTime_dbClusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Text
dbClusterIdentifier :: Text
$sel:dbClusterIdentifier:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Text
dbClusterIdentifier} -> Text
dbClusterIdentifier) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Text
a -> RestoreDBClusterToPointInTime
s {$sel:dbClusterIdentifier:RestoreDBClusterToPointInTime' :: Text
dbClusterIdentifier = Text
a} :: RestoreDBClusterToPointInTime)

-- | The identifier of the source DB cluster from which to restore.
--
-- Constraints:
--
-- -   Must match the identifier of an existing DBCluster.
restoreDBClusterToPointInTime_sourceDBClusterIdentifier :: Lens.Lens' RestoreDBClusterToPointInTime Prelude.Text
restoreDBClusterToPointInTime_sourceDBClusterIdentifier :: Lens' RestoreDBClusterToPointInTime Text
restoreDBClusterToPointInTime_sourceDBClusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTime' {Text
sourceDBClusterIdentifier :: Text
$sel:sourceDBClusterIdentifier:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Text
sourceDBClusterIdentifier} -> Text
sourceDBClusterIdentifier) (\s :: RestoreDBClusterToPointInTime
s@RestoreDBClusterToPointInTime' {} Text
a -> RestoreDBClusterToPointInTime
s {$sel:sourceDBClusterIdentifier:RestoreDBClusterToPointInTime' :: Text
sourceDBClusterIdentifier = Text
a} :: RestoreDBClusterToPointInTime)

instance
  Core.AWSRequest
    RestoreDBClusterToPointInTime
  where
  type
    AWSResponse RestoreDBClusterToPointInTime =
      RestoreDBClusterToPointInTimeResponse
  request :: (Service -> Service)
-> RestoreDBClusterToPointInTime
-> Request RestoreDBClusterToPointInTime
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 RestoreDBClusterToPointInTime
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RestoreDBClusterToPointInTime)))
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
"RestoreDBClusterToPointInTimeResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe DBCluster -> Int -> RestoreDBClusterToPointInTimeResponse
RestoreDBClusterToPointInTimeResponse'
            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
"DBCluster")
            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
    RestoreDBClusterToPointInTime
  where
  hashWithSalt :: Int -> RestoreDBClusterToPointInTime -> Int
hashWithSalt Int
_salt RestoreDBClusterToPointInTime' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe [Tag]
Maybe Text
Maybe ISO8601
Maybe ServerlessV2ScalingConfiguration
Text
sourceDBClusterIdentifier :: Text
dbClusterIdentifier :: Text
vpcSecurityGroupIds :: Maybe [Text]
useLatestRestorableTime :: Maybe Bool
tags :: Maybe [Tag]
serverlessV2ScalingConfiguration :: Maybe ServerlessV2ScalingConfiguration
restoreType :: Maybe Text
restoreToTime :: Maybe ISO8601
port :: Maybe Int
optionGroupName :: Maybe Text
kmsKeyId :: Maybe Text
enableIAMDatabaseAuthentication :: Maybe Bool
enableCloudwatchLogsExports :: Maybe [Text]
deletionProtection :: Maybe Bool
dbSubnetGroupName :: Maybe Text
dbClusterParameterGroupName :: Maybe Text
$sel:sourceDBClusterIdentifier:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Text
$sel:dbClusterIdentifier:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Text
$sel:vpcSecurityGroupIds:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe [Text]
$sel:useLatestRestorableTime:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
$sel:tags:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe [Tag]
$sel:serverlessV2ScalingConfiguration:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime
-> Maybe ServerlessV2ScalingConfiguration
$sel:restoreType:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:restoreToTime:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe ISO8601
$sel:port:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Int
$sel:optionGroupName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:kmsKeyId:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:enableIAMDatabaseAuthentication:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
$sel:enableCloudwatchLogsExports:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe [Text]
$sel:deletionProtection:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
$sel:dbSubnetGroupName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:dbClusterParameterGroupName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dbClusterParameterGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dbSubnetGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
deletionProtection
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
enableCloudwatchLogsExports
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enableIAMDatabaseAuthentication
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
optionGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
port
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
restoreToTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
restoreType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ServerlessV2ScalingConfiguration
serverlessV2ScalingConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
useLatestRestorableTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
vpcSecurityGroupIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dbClusterIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sourceDBClusterIdentifier

instance Prelude.NFData RestoreDBClusterToPointInTime where
  rnf :: RestoreDBClusterToPointInTime -> ()
rnf RestoreDBClusterToPointInTime' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe [Tag]
Maybe Text
Maybe ISO8601
Maybe ServerlessV2ScalingConfiguration
Text
sourceDBClusterIdentifier :: Text
dbClusterIdentifier :: Text
vpcSecurityGroupIds :: Maybe [Text]
useLatestRestorableTime :: Maybe Bool
tags :: Maybe [Tag]
serverlessV2ScalingConfiguration :: Maybe ServerlessV2ScalingConfiguration
restoreType :: Maybe Text
restoreToTime :: Maybe ISO8601
port :: Maybe Int
optionGroupName :: Maybe Text
kmsKeyId :: Maybe Text
enableIAMDatabaseAuthentication :: Maybe Bool
enableCloudwatchLogsExports :: Maybe [Text]
deletionProtection :: Maybe Bool
dbSubnetGroupName :: Maybe Text
dbClusterParameterGroupName :: Maybe Text
$sel:sourceDBClusterIdentifier:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Text
$sel:dbClusterIdentifier:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Text
$sel:vpcSecurityGroupIds:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe [Text]
$sel:useLatestRestorableTime:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
$sel:tags:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe [Tag]
$sel:serverlessV2ScalingConfiguration:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime
-> Maybe ServerlessV2ScalingConfiguration
$sel:restoreType:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:restoreToTime:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe ISO8601
$sel:port:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Int
$sel:optionGroupName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:kmsKeyId:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:enableIAMDatabaseAuthentication:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
$sel:enableCloudwatchLogsExports:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe [Text]
$sel:deletionProtection:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
$sel:dbSubnetGroupName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:dbClusterParameterGroupName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dbClusterParameterGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dbSubnetGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
deletionProtection
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
enableCloudwatchLogsExports
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enableIAMDatabaseAuthentication
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKeyId
      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 Maybe Int
port
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
restoreToTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
restoreType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ServerlessV2ScalingConfiguration
serverlessV2ScalingConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
useLatestRestorableTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
vpcSecurityGroupIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dbClusterIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
sourceDBClusterIdentifier

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

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

instance Data.ToQuery RestoreDBClusterToPointInTime where
  toQuery :: RestoreDBClusterToPointInTime -> QueryString
toQuery RestoreDBClusterToPointInTime' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe [Tag]
Maybe Text
Maybe ISO8601
Maybe ServerlessV2ScalingConfiguration
Text
sourceDBClusterIdentifier :: Text
dbClusterIdentifier :: Text
vpcSecurityGroupIds :: Maybe [Text]
useLatestRestorableTime :: Maybe Bool
tags :: Maybe [Tag]
serverlessV2ScalingConfiguration :: Maybe ServerlessV2ScalingConfiguration
restoreType :: Maybe Text
restoreToTime :: Maybe ISO8601
port :: Maybe Int
optionGroupName :: Maybe Text
kmsKeyId :: Maybe Text
enableIAMDatabaseAuthentication :: Maybe Bool
enableCloudwatchLogsExports :: Maybe [Text]
deletionProtection :: Maybe Bool
dbSubnetGroupName :: Maybe Text
dbClusterParameterGroupName :: Maybe Text
$sel:sourceDBClusterIdentifier:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Text
$sel:dbClusterIdentifier:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Text
$sel:vpcSecurityGroupIds:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe [Text]
$sel:useLatestRestorableTime:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
$sel:tags:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe [Tag]
$sel:serverlessV2ScalingConfiguration:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime
-> Maybe ServerlessV2ScalingConfiguration
$sel:restoreType:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:restoreToTime:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe ISO8601
$sel:port:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Int
$sel:optionGroupName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:kmsKeyId:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:enableIAMDatabaseAuthentication:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
$sel:enableCloudwatchLogsExports:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe [Text]
$sel:deletionProtection:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
$sel:dbSubnetGroupName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:dbClusterParameterGroupName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"RestoreDBClusterToPointInTime" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"DBClusterParameterGroupName"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
dbClusterParameterGroupName,
        ByteString
"DBSubnetGroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
dbSubnetGroupName,
        ByteString
"DeletionProtection" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
deletionProtection,
        ByteString
"EnableCloudwatchLogsExports"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
enableCloudwatchLogsExports
            ),
        ByteString
"EnableIAMDatabaseAuthentication"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
enableIAMDatabaseAuthentication,
        ByteString
"KmsKeyId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
kmsKeyId,
        ByteString
"OptionGroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
optionGroupName,
        ByteString
"Port" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
port,
        ByteString
"RestoreToTime" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ISO8601
restoreToTime,
        ByteString
"RestoreType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
restoreType,
        ByteString
"ServerlessV2ScalingConfiguration"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ServerlessV2ScalingConfiguration
serverlessV2ScalingConfiguration,
        ByteString
"Tags"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"Tag" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags),
        ByteString
"UseLatestRestorableTime"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
useLatestRestorableTime,
        ByteString
"VpcSecurityGroupIds"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"VpcSecurityGroupId"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
vpcSecurityGroupIds
            ),
        ByteString
"DBClusterIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
dbClusterIdentifier,
        ByteString
"SourceDBClusterIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
sourceDBClusterIdentifier
      ]

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

-- |
-- Create a value of 'RestoreDBClusterToPointInTimeResponse' 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:
--
-- 'dbCluster', 'restoreDBClusterToPointInTimeResponse_dbCluster' - Undocumented member.
--
-- 'httpStatus', 'restoreDBClusterToPointInTimeResponse_httpStatus' - The response's http status code.
newRestoreDBClusterToPointInTimeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RestoreDBClusterToPointInTimeResponse
newRestoreDBClusterToPointInTimeResponse :: Int -> RestoreDBClusterToPointInTimeResponse
newRestoreDBClusterToPointInTimeResponse Int
pHttpStatus_ =
  RestoreDBClusterToPointInTimeResponse'
    { $sel:dbCluster:RestoreDBClusterToPointInTimeResponse' :: Maybe DBCluster
dbCluster =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RestoreDBClusterToPointInTimeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
restoreDBClusterToPointInTimeResponse_dbCluster :: Lens.Lens' RestoreDBClusterToPointInTimeResponse (Prelude.Maybe DBCluster)
restoreDBClusterToPointInTimeResponse_dbCluster :: Lens' RestoreDBClusterToPointInTimeResponse (Maybe DBCluster)
restoreDBClusterToPointInTimeResponse_dbCluster = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreDBClusterToPointInTimeResponse' {Maybe DBCluster
dbCluster :: Maybe DBCluster
$sel:dbCluster:RestoreDBClusterToPointInTimeResponse' :: RestoreDBClusterToPointInTimeResponse -> Maybe DBCluster
dbCluster} -> Maybe DBCluster
dbCluster) (\s :: RestoreDBClusterToPointInTimeResponse
s@RestoreDBClusterToPointInTimeResponse' {} Maybe DBCluster
a -> RestoreDBClusterToPointInTimeResponse
s {$sel:dbCluster:RestoreDBClusterToPointInTimeResponse' :: Maybe DBCluster
dbCluster = Maybe DBCluster
a} :: RestoreDBClusterToPointInTimeResponse)

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

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