{-# 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.DocumentDB.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 cluster to an arbitrary point in time. Users can restore to
-- any point in time before @LatestRestorableTime@ for up to
-- @BackupRetentionPeriod@ days. The target cluster is created from the
-- source cluster with the same configuration as the original cluster,
-- except that the new cluster is created with the default security group.
module Amazonka.DocumentDB.RestoreDBClusterToPointInTime
  ( -- * Creating a Request
    RestoreDBClusterToPointInTime (..),
    newRestoreDBClusterToPointInTime,

    -- * Request Lenses
    restoreDBClusterToPointInTime_dbSubnetGroupName,
    restoreDBClusterToPointInTime_deletionProtection,
    restoreDBClusterToPointInTime_enableCloudwatchLogsExports,
    restoreDBClusterToPointInTime_kmsKeyId,
    restoreDBClusterToPointInTime_port,
    restoreDBClusterToPointInTime_restoreToTime,
    restoreDBClusterToPointInTime_restoreType,
    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.DocumentDB.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | Represents the input to RestoreDBClusterToPointInTime.
--
-- /See:/ 'newRestoreDBClusterToPointInTime' smart constructor.
data RestoreDBClusterToPointInTime = RestoreDBClusterToPointInTime'
  { -- | The subnet group name to use for the new cluster.
    --
    -- Constraints: If provided, must match the name of an existing
    -- @DBSubnetGroup@.
    --
    -- Example: @mySubnetgroup@
    RestoreDBClusterToPointInTime -> Maybe Text
dbSubnetGroupName :: Prelude.Maybe Prelude.Text,
    -- | Specifies whether this cluster can be deleted. If @DeletionProtection@
    -- is enabled, the cluster cannot be deleted unless it is modified and
    -- @DeletionProtection@ is disabled. @DeletionProtection@ protects clusters
    -- from being accidentally deleted.
    RestoreDBClusterToPointInTime -> Maybe Bool
deletionProtection :: Prelude.Maybe Prelude.Bool,
    -- | A list of log types that must be enabled for exporting to Amazon
    -- CloudWatch Logs.
    RestoreDBClusterToPointInTime -> Maybe [Text]
enableCloudwatchLogsExports :: Prelude.Maybe [Prelude.Text],
    -- | The KMS key identifier to use when restoring an encrypted cluster from
    -- an encrypted cluster.
    --
    -- The KMS key identifier is the Amazon Resource Name (ARN) for the KMS
    -- encryption key. If you are restoring a cluster with the same Amazon Web
    -- Services account that owns the KMS encryption key used to encrypt the
    -- new cluster, then you can use the KMS key alias instead of the ARN for
    -- the KMS encryption key.
    --
    -- You can restore to a new cluster and encrypt the new cluster with an KMS
    -- key that is different from the KMS key used to encrypt the source
    -- 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 occurs:
    --
    -- -   If the cluster is encrypted, then the restored cluster is encrypted
    --     using the KMS key that was used to encrypt the source cluster.
    --
    -- -   If the cluster is not encrypted, then the restored cluster is not
    --     encrypted.
    --
    -- If @DBClusterIdentifier@ refers to a cluster that is not encrypted, then
    -- the restore request is rejected.
    RestoreDBClusterToPointInTime -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | The port number on which the new cluster accepts connections.
    --
    -- Constraints: Must be a value from @1150@ to @65535@.
    --
    -- Default: The default port for the engine.
    RestoreDBClusterToPointInTime -> Maybe Int
port :: Prelude.Maybe Prelude.Int,
    -- | The date and time to restore the cluster to.
    --
    -- Valid values: A time in Universal Coordinated Time (UTC) format.
    --
    -- Constraints:
    --
    -- -   Must be before the latest restorable time for the instance.
    --
    -- -   Must be specified if the @UseLatestRestorableTime@ parameter is not
    --     provided.
    --
    -- -   Cannot be specified if the @UseLatestRestorableTime@ parameter is
    --     @true@.
    --
    -- -   Cannot be specified if the @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,
    -- | The tags to be assigned to the restored cluster.
    RestoreDBClusterToPointInTime -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | A value that is set to @true@ to restore the cluster to the latest
    -- restorable backup time, and @false@ otherwise.
    --
    -- Default: @false@
    --
    -- Constraints: Cannot be specified if the @RestoreToTime@ parameter is
    -- provided.
    RestoreDBClusterToPointInTime -> Maybe Bool
useLatestRestorableTime :: Prelude.Maybe Prelude.Bool,
    -- | A list of VPC security groups that the new cluster belongs to.
    RestoreDBClusterToPointInTime -> Maybe [Text]
vpcSecurityGroupIds :: Prelude.Maybe [Prelude.Text],
    -- | The name of the new cluster to be created.
    --
    -- Constraints:
    --
    -- -   Must contain from 1 to 63 letters, numbers, or hyphens.
    --
    -- -   The 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 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:
--
-- 'dbSubnetGroupName', 'restoreDBClusterToPointInTime_dbSubnetGroupName' - The subnet group name to use for the new cluster.
--
-- Constraints: If provided, must match the name of an existing
-- @DBSubnetGroup@.
--
-- Example: @mySubnetgroup@
--
-- 'deletionProtection', 'restoreDBClusterToPointInTime_deletionProtection' - Specifies whether this cluster can be deleted. If @DeletionProtection@
-- is enabled, the cluster cannot be deleted unless it is modified and
-- @DeletionProtection@ is disabled. @DeletionProtection@ protects clusters
-- from being accidentally deleted.
--
-- 'enableCloudwatchLogsExports', 'restoreDBClusterToPointInTime_enableCloudwatchLogsExports' - A list of log types that must be enabled for exporting to Amazon
-- CloudWatch Logs.
--
-- 'kmsKeyId', 'restoreDBClusterToPointInTime_kmsKeyId' - The KMS key identifier to use when restoring an encrypted cluster from
-- an encrypted cluster.
--
-- The KMS key identifier is the Amazon Resource Name (ARN) for the KMS
-- encryption key. If you are restoring a cluster with the same Amazon Web
-- Services account that owns the KMS encryption key used to encrypt the
-- new cluster, then you can use the KMS key alias instead of the ARN for
-- the KMS encryption key.
--
-- You can restore to a new cluster and encrypt the new cluster with an KMS
-- key that is different from the KMS key used to encrypt the source
-- 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 occurs:
--
-- -   If the cluster is encrypted, then the restored cluster is encrypted
--     using the KMS key that was used to encrypt the source cluster.
--
-- -   If the cluster is not encrypted, then the restored cluster is not
--     encrypted.
--
-- If @DBClusterIdentifier@ refers to a cluster that is not encrypted, then
-- the restore request is rejected.
--
-- 'port', 'restoreDBClusterToPointInTime_port' - The port number on which the new cluster accepts connections.
--
-- Constraints: Must be a value from @1150@ to @65535@.
--
-- Default: The default port for the engine.
--
-- 'restoreToTime', 'restoreDBClusterToPointInTime_restoreToTime' - The date and time to restore the cluster to.
--
-- Valid values: A time in Universal Coordinated Time (UTC) format.
--
-- Constraints:
--
-- -   Must be before the latest restorable time for the instance.
--
-- -   Must be specified if the @UseLatestRestorableTime@ parameter is not
--     provided.
--
-- -   Cannot be specified if the @UseLatestRestorableTime@ parameter is
--     @true@.
--
-- -   Cannot be specified if the @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.
--
-- 'tags', 'restoreDBClusterToPointInTime_tags' - The tags to be assigned to the restored cluster.
--
-- 'useLatestRestorableTime', 'restoreDBClusterToPointInTime_useLatestRestorableTime' - A value that is set to @true@ to restore the cluster to the latest
-- restorable backup time, and @false@ otherwise.
--
-- Default: @false@
--
-- Constraints: Cannot be specified if the @RestoreToTime@ parameter is
-- provided.
--
-- 'vpcSecurityGroupIds', 'restoreDBClusterToPointInTime_vpcSecurityGroupIds' - A list of VPC security groups that the new cluster belongs to.
--
-- 'dbClusterIdentifier', 'restoreDBClusterToPointInTime_dbClusterIdentifier' - The name of the new cluster to be created.
--
-- Constraints:
--
-- -   Must contain from 1 to 63 letters, numbers, or hyphens.
--
-- -   The first character must be a letter.
--
-- -   Cannot end with a hyphen or contain two consecutive hyphens.
--
-- 'sourceDBClusterIdentifier', 'restoreDBClusterToPointInTime_sourceDBClusterIdentifier' - The identifier of the source 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: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:kmsKeyId:RestoreDBClusterToPointInTime' :: Maybe Text
kmsKeyId = 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: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 subnet group name to use for the new cluster.
--
-- Constraints: If provided, 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)

-- | Specifies whether this cluster can be deleted. If @DeletionProtection@
-- is enabled, the cluster cannot be deleted unless it is modified and
-- @DeletionProtection@ is disabled. @DeletionProtection@ protects clusters
-- from being accidentally deleted.
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)

-- | A list of log types that must be enabled for exporting to Amazon
-- 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

-- | The KMS key identifier to use when restoring an encrypted cluster from
-- an encrypted cluster.
--
-- The KMS key identifier is the Amazon Resource Name (ARN) for the KMS
-- encryption key. If you are restoring a cluster with the same Amazon Web
-- Services account that owns the KMS encryption key used to encrypt the
-- new cluster, then you can use the KMS key alias instead of the ARN for
-- the KMS encryption key.
--
-- You can restore to a new cluster and encrypt the new cluster with an KMS
-- key that is different from the KMS key used to encrypt the source
-- 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 occurs:
--
-- -   If the cluster is encrypted, then the restored cluster is encrypted
--     using the KMS key that was used to encrypt the source cluster.
--
-- -   If the cluster is not encrypted, then the restored cluster is not
--     encrypted.
--
-- If @DBClusterIdentifier@ refers to a 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)

-- | The port number on which the new cluster accepts connections.
--
-- Constraints: Must be a value from @1150@ to @65535@.
--
-- Default: The default port for the engine.
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 cluster to.
--
-- Valid values: A time in Universal Coordinated Time (UTC) format.
--
-- Constraints:
--
-- -   Must be before the latest restorable time for the instance.
--
-- -   Must be specified if the @UseLatestRestorableTime@ parameter is not
--     provided.
--
-- -   Cannot be specified if the @UseLatestRestorableTime@ parameter is
--     @true@.
--
-- -   Cannot be specified if the @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)

-- | The tags to be assigned to the restored 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 cluster to the latest
-- restorable backup time, and @false@ otherwise.
--
-- Default: @false@
--
-- Constraints: Cannot be specified if the @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 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 cluster to be created.
--
-- Constraints:
--
-- -   Must contain from 1 to 63 letters, numbers, or hyphens.
--
-- -   The 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 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
Text
sourceDBClusterIdentifier :: Text
dbClusterIdentifier :: Text
vpcSecurityGroupIds :: Maybe [Text]
useLatestRestorableTime :: Maybe Bool
tags :: Maybe [Tag]
restoreType :: Maybe Text
restoreToTime :: Maybe ISO8601
port :: Maybe Int
kmsKeyId :: Maybe Text
enableCloudwatchLogsExports :: Maybe [Text]
deletionProtection :: Maybe Bool
dbSubnetGroupName :: 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:restoreType:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:restoreToTime:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe ISO8601
$sel:port:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Int
$sel:kmsKeyId:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:enableCloudwatchLogsExports:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe [Text]
$sel:deletionProtection:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
$sel:dbSubnetGroupName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
..} =
    Int
_salt
      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 Text
kmsKeyId
      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 [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
Text
sourceDBClusterIdentifier :: Text
dbClusterIdentifier :: Text
vpcSecurityGroupIds :: Maybe [Text]
useLatestRestorableTime :: Maybe Bool
tags :: Maybe [Tag]
restoreType :: Maybe Text
restoreToTime :: Maybe ISO8601
port :: Maybe Int
kmsKeyId :: Maybe Text
enableCloudwatchLogsExports :: Maybe [Text]
deletionProtection :: Maybe Bool
dbSubnetGroupName :: 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:restoreType:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:restoreToTime:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe ISO8601
$sel:port:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Int
$sel:kmsKeyId:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:enableCloudwatchLogsExports:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe [Text]
$sel:deletionProtection:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
$sel:dbSubnetGroupName:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
..} =
    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 Text
kmsKeyId
      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 [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
Text
sourceDBClusterIdentifier :: Text
dbClusterIdentifier :: Text
vpcSecurityGroupIds :: Maybe [Text]
useLatestRestorableTime :: Maybe Bool
tags :: Maybe [Tag]
restoreType :: Maybe Text
restoreToTime :: Maybe ISO8601
port :: Maybe Int
kmsKeyId :: Maybe Text
enableCloudwatchLogsExports :: Maybe [Text]
deletionProtection :: Maybe Bool
dbSubnetGroupName :: 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:restoreType:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:restoreToTime:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe ISO8601
$sel:port:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Int
$sel:kmsKeyId:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Text
$sel:enableCloudwatchLogsExports:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe [Text]
$sel:deletionProtection:RestoreDBClusterToPointInTime' :: RestoreDBClusterToPointInTime -> Maybe Bool
$sel:dbSubnetGroupName: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
"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
"KmsKeyId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
kmsKeyId,
        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
"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