{-# 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.DynamoDB.RestoreTableToPointInTime
-- 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 the specified table to the specified point in time within
-- @EarliestRestorableDateTime@ and @LatestRestorableDateTime@. You can
-- restore your table to any point in time during the last 35 days. Any
-- number of users can execute up to 4 concurrent restores (any type of
-- restore) in a given account.
--
-- When you restore using point in time recovery, DynamoDB restores your
-- table data to the state based on the selected date and time
-- (day:hour:minute:second) to a new table.
--
-- Along with data, the following are also included on the new restored
-- table using point in time recovery:
--
-- -   Global secondary indexes (GSIs)
--
-- -   Local secondary indexes (LSIs)
--
-- -   Provisioned read and write capacity
--
-- -   Encryption settings
--
--     All these settings come from the current settings of the source
--     table at the time of restore.
--
-- You must manually set up the following on the restored table:
--
-- -   Auto scaling policies
--
-- -   IAM policies
--
-- -   Amazon CloudWatch metrics and alarms
--
-- -   Tags
--
-- -   Stream settings
--
-- -   Time to Live (TTL) settings
--
-- -   Point in time recovery settings
module Amazonka.DynamoDB.RestoreTableToPointInTime
  ( -- * Creating a Request
    RestoreTableToPointInTime (..),
    newRestoreTableToPointInTime,

    -- * Request Lenses
    restoreTableToPointInTime_billingModeOverride,
    restoreTableToPointInTime_globalSecondaryIndexOverride,
    restoreTableToPointInTime_localSecondaryIndexOverride,
    restoreTableToPointInTime_provisionedThroughputOverride,
    restoreTableToPointInTime_restoreDateTime,
    restoreTableToPointInTime_sSESpecificationOverride,
    restoreTableToPointInTime_sourceTableArn,
    restoreTableToPointInTime_sourceTableName,
    restoreTableToPointInTime_useLatestRestorableTime,
    restoreTableToPointInTime_targetTableName,

    -- * Destructuring the Response
    RestoreTableToPointInTimeResponse (..),
    newRestoreTableToPointInTimeResponse,

    -- * Response Lenses
    restoreTableToPointInTimeResponse_tableDescription,
    restoreTableToPointInTimeResponse_httpStatus,
  )
where

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

-- | /See:/ 'newRestoreTableToPointInTime' smart constructor.
data RestoreTableToPointInTime = RestoreTableToPointInTime'
  { -- | The billing mode of the restored table.
    RestoreTableToPointInTime -> Maybe BillingMode
billingModeOverride :: Prelude.Maybe BillingMode,
    -- | List of global secondary indexes for the restored table. The indexes
    -- provided should match existing secondary indexes. You can choose to
    -- exclude some or all of the indexes at the time of restore.
    RestoreTableToPointInTime -> Maybe [GlobalSecondaryIndex]
globalSecondaryIndexOverride :: Prelude.Maybe [GlobalSecondaryIndex],
    -- | List of local secondary indexes for the restored table. The indexes
    -- provided should match existing secondary indexes. You can choose to
    -- exclude some or all of the indexes at the time of restore.
    RestoreTableToPointInTime -> Maybe [LocalSecondaryIndex]
localSecondaryIndexOverride :: Prelude.Maybe [LocalSecondaryIndex],
    -- | Provisioned throughput settings for the restored table.
    RestoreTableToPointInTime -> Maybe ProvisionedThroughput
provisionedThroughputOverride :: Prelude.Maybe ProvisionedThroughput,
    -- | Time in the past to restore the table to.
    RestoreTableToPointInTime -> Maybe POSIX
restoreDateTime :: Prelude.Maybe Data.POSIX,
    -- | The new server-side encryption settings for the restored table.
    RestoreTableToPointInTime -> Maybe SSESpecification
sSESpecificationOverride :: Prelude.Maybe SSESpecification,
    -- | The DynamoDB table that will be restored. This value is an Amazon
    -- Resource Name (ARN).
    RestoreTableToPointInTime -> Maybe Text
sourceTableArn :: Prelude.Maybe Prelude.Text,
    -- | Name of the source table that is being restored.
    RestoreTableToPointInTime -> Maybe Text
sourceTableName :: Prelude.Maybe Prelude.Text,
    -- | Restore the table to the latest possible time.
    -- @LatestRestorableDateTime@ is typically 5 minutes before the current
    -- time.
    RestoreTableToPointInTime -> Maybe Bool
useLatestRestorableTime :: Prelude.Maybe Prelude.Bool,
    -- | The name of the new table to which it must be restored to.
    RestoreTableToPointInTime -> Text
targetTableName :: Prelude.Text
  }
  deriving (RestoreTableToPointInTime -> RestoreTableToPointInTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RestoreTableToPointInTime -> RestoreTableToPointInTime -> Bool
$c/= :: RestoreTableToPointInTime -> RestoreTableToPointInTime -> Bool
== :: RestoreTableToPointInTime -> RestoreTableToPointInTime -> Bool
$c== :: RestoreTableToPointInTime -> RestoreTableToPointInTime -> Bool
Prelude.Eq, ReadPrec [RestoreTableToPointInTime]
ReadPrec RestoreTableToPointInTime
Int -> ReadS RestoreTableToPointInTime
ReadS [RestoreTableToPointInTime]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RestoreTableToPointInTime]
$creadListPrec :: ReadPrec [RestoreTableToPointInTime]
readPrec :: ReadPrec RestoreTableToPointInTime
$creadPrec :: ReadPrec RestoreTableToPointInTime
readList :: ReadS [RestoreTableToPointInTime]
$creadList :: ReadS [RestoreTableToPointInTime]
readsPrec :: Int -> ReadS RestoreTableToPointInTime
$creadsPrec :: Int -> ReadS RestoreTableToPointInTime
Prelude.Read, Int -> RestoreTableToPointInTime -> ShowS
[RestoreTableToPointInTime] -> ShowS
RestoreTableToPointInTime -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RestoreTableToPointInTime] -> ShowS
$cshowList :: [RestoreTableToPointInTime] -> ShowS
show :: RestoreTableToPointInTime -> String
$cshow :: RestoreTableToPointInTime -> String
showsPrec :: Int -> RestoreTableToPointInTime -> ShowS
$cshowsPrec :: Int -> RestoreTableToPointInTime -> ShowS
Prelude.Show, forall x.
Rep RestoreTableToPointInTime x -> RestoreTableToPointInTime
forall x.
RestoreTableToPointInTime -> Rep RestoreTableToPointInTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RestoreTableToPointInTime x -> RestoreTableToPointInTime
$cfrom :: forall x.
RestoreTableToPointInTime -> Rep RestoreTableToPointInTime x
Prelude.Generic)

-- |
-- Create a value of 'RestoreTableToPointInTime' 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:
--
-- 'billingModeOverride', 'restoreTableToPointInTime_billingModeOverride' - The billing mode of the restored table.
--
-- 'globalSecondaryIndexOverride', 'restoreTableToPointInTime_globalSecondaryIndexOverride' - List of global secondary indexes for the restored table. The indexes
-- provided should match existing secondary indexes. You can choose to
-- exclude some or all of the indexes at the time of restore.
--
-- 'localSecondaryIndexOverride', 'restoreTableToPointInTime_localSecondaryIndexOverride' - List of local secondary indexes for the restored table. The indexes
-- provided should match existing secondary indexes. You can choose to
-- exclude some or all of the indexes at the time of restore.
--
-- 'provisionedThroughputOverride', 'restoreTableToPointInTime_provisionedThroughputOverride' - Provisioned throughput settings for the restored table.
--
-- 'restoreDateTime', 'restoreTableToPointInTime_restoreDateTime' - Time in the past to restore the table to.
--
-- 'sSESpecificationOverride', 'restoreTableToPointInTime_sSESpecificationOverride' - The new server-side encryption settings for the restored table.
--
-- 'sourceTableArn', 'restoreTableToPointInTime_sourceTableArn' - The DynamoDB table that will be restored. This value is an Amazon
-- Resource Name (ARN).
--
-- 'sourceTableName', 'restoreTableToPointInTime_sourceTableName' - Name of the source table that is being restored.
--
-- 'useLatestRestorableTime', 'restoreTableToPointInTime_useLatestRestorableTime' - Restore the table to the latest possible time.
-- @LatestRestorableDateTime@ is typically 5 minutes before the current
-- time.
--
-- 'targetTableName', 'restoreTableToPointInTime_targetTableName' - The name of the new table to which it must be restored to.
newRestoreTableToPointInTime ::
  -- | 'targetTableName'
  Prelude.Text ->
  RestoreTableToPointInTime
newRestoreTableToPointInTime :: Text -> RestoreTableToPointInTime
newRestoreTableToPointInTime Text
pTargetTableName_ =
  RestoreTableToPointInTime'
    { $sel:billingModeOverride:RestoreTableToPointInTime' :: Maybe BillingMode
billingModeOverride =
        forall a. Maybe a
Prelude.Nothing,
      $sel:globalSecondaryIndexOverride:RestoreTableToPointInTime' :: Maybe [GlobalSecondaryIndex]
globalSecondaryIndexOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:localSecondaryIndexOverride:RestoreTableToPointInTime' :: Maybe [LocalSecondaryIndex]
localSecondaryIndexOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:provisionedThroughputOverride:RestoreTableToPointInTime' :: Maybe ProvisionedThroughput
provisionedThroughputOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:restoreDateTime:RestoreTableToPointInTime' :: Maybe POSIX
restoreDateTime = forall a. Maybe a
Prelude.Nothing,
      $sel:sSESpecificationOverride:RestoreTableToPointInTime' :: Maybe SSESpecification
sSESpecificationOverride = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceTableArn:RestoreTableToPointInTime' :: Maybe Text
sourceTableArn = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceTableName:RestoreTableToPointInTime' :: Maybe Text
sourceTableName = forall a. Maybe a
Prelude.Nothing,
      $sel:useLatestRestorableTime:RestoreTableToPointInTime' :: Maybe Bool
useLatestRestorableTime = forall a. Maybe a
Prelude.Nothing,
      $sel:targetTableName:RestoreTableToPointInTime' :: Text
targetTableName = Text
pTargetTableName_
    }

-- | The billing mode of the restored table.
restoreTableToPointInTime_billingModeOverride :: Lens.Lens' RestoreTableToPointInTime (Prelude.Maybe BillingMode)
restoreTableToPointInTime_billingModeOverride :: Lens' RestoreTableToPointInTime (Maybe BillingMode)
restoreTableToPointInTime_billingModeOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreTableToPointInTime' {Maybe BillingMode
billingModeOverride :: Maybe BillingMode
$sel:billingModeOverride:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe BillingMode
billingModeOverride} -> Maybe BillingMode
billingModeOverride) (\s :: RestoreTableToPointInTime
s@RestoreTableToPointInTime' {} Maybe BillingMode
a -> RestoreTableToPointInTime
s {$sel:billingModeOverride:RestoreTableToPointInTime' :: Maybe BillingMode
billingModeOverride = Maybe BillingMode
a} :: RestoreTableToPointInTime)

-- | List of global secondary indexes for the restored table. The indexes
-- provided should match existing secondary indexes. You can choose to
-- exclude some or all of the indexes at the time of restore.
restoreTableToPointInTime_globalSecondaryIndexOverride :: Lens.Lens' RestoreTableToPointInTime (Prelude.Maybe [GlobalSecondaryIndex])
restoreTableToPointInTime_globalSecondaryIndexOverride :: Lens' RestoreTableToPointInTime (Maybe [GlobalSecondaryIndex])
restoreTableToPointInTime_globalSecondaryIndexOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreTableToPointInTime' {Maybe [GlobalSecondaryIndex]
globalSecondaryIndexOverride :: Maybe [GlobalSecondaryIndex]
$sel:globalSecondaryIndexOverride:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe [GlobalSecondaryIndex]
globalSecondaryIndexOverride} -> Maybe [GlobalSecondaryIndex]
globalSecondaryIndexOverride) (\s :: RestoreTableToPointInTime
s@RestoreTableToPointInTime' {} Maybe [GlobalSecondaryIndex]
a -> RestoreTableToPointInTime
s {$sel:globalSecondaryIndexOverride:RestoreTableToPointInTime' :: Maybe [GlobalSecondaryIndex]
globalSecondaryIndexOverride = Maybe [GlobalSecondaryIndex]
a} :: RestoreTableToPointInTime) 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

-- | List of local secondary indexes for the restored table. The indexes
-- provided should match existing secondary indexes. You can choose to
-- exclude some or all of the indexes at the time of restore.
restoreTableToPointInTime_localSecondaryIndexOverride :: Lens.Lens' RestoreTableToPointInTime (Prelude.Maybe [LocalSecondaryIndex])
restoreTableToPointInTime_localSecondaryIndexOverride :: Lens' RestoreTableToPointInTime (Maybe [LocalSecondaryIndex])
restoreTableToPointInTime_localSecondaryIndexOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreTableToPointInTime' {Maybe [LocalSecondaryIndex]
localSecondaryIndexOverride :: Maybe [LocalSecondaryIndex]
$sel:localSecondaryIndexOverride:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe [LocalSecondaryIndex]
localSecondaryIndexOverride} -> Maybe [LocalSecondaryIndex]
localSecondaryIndexOverride) (\s :: RestoreTableToPointInTime
s@RestoreTableToPointInTime' {} Maybe [LocalSecondaryIndex]
a -> RestoreTableToPointInTime
s {$sel:localSecondaryIndexOverride:RestoreTableToPointInTime' :: Maybe [LocalSecondaryIndex]
localSecondaryIndexOverride = Maybe [LocalSecondaryIndex]
a} :: RestoreTableToPointInTime) 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

-- | Provisioned throughput settings for the restored table.
restoreTableToPointInTime_provisionedThroughputOverride :: Lens.Lens' RestoreTableToPointInTime (Prelude.Maybe ProvisionedThroughput)
restoreTableToPointInTime_provisionedThroughputOverride :: Lens' RestoreTableToPointInTime (Maybe ProvisionedThroughput)
restoreTableToPointInTime_provisionedThroughputOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreTableToPointInTime' {Maybe ProvisionedThroughput
provisionedThroughputOverride :: Maybe ProvisionedThroughput
$sel:provisionedThroughputOverride:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe ProvisionedThroughput
provisionedThroughputOverride} -> Maybe ProvisionedThroughput
provisionedThroughputOverride) (\s :: RestoreTableToPointInTime
s@RestoreTableToPointInTime' {} Maybe ProvisionedThroughput
a -> RestoreTableToPointInTime
s {$sel:provisionedThroughputOverride:RestoreTableToPointInTime' :: Maybe ProvisionedThroughput
provisionedThroughputOverride = Maybe ProvisionedThroughput
a} :: RestoreTableToPointInTime)

-- | Time in the past to restore the table to.
restoreTableToPointInTime_restoreDateTime :: Lens.Lens' RestoreTableToPointInTime (Prelude.Maybe Prelude.UTCTime)
restoreTableToPointInTime_restoreDateTime :: Lens' RestoreTableToPointInTime (Maybe UTCTime)
restoreTableToPointInTime_restoreDateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreTableToPointInTime' {Maybe POSIX
restoreDateTime :: Maybe POSIX
$sel:restoreDateTime:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe POSIX
restoreDateTime} -> Maybe POSIX
restoreDateTime) (\s :: RestoreTableToPointInTime
s@RestoreTableToPointInTime' {} Maybe POSIX
a -> RestoreTableToPointInTime
s {$sel:restoreDateTime:RestoreTableToPointInTime' :: Maybe POSIX
restoreDateTime = Maybe POSIX
a} :: RestoreTableToPointInTime) 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 new server-side encryption settings for the restored table.
restoreTableToPointInTime_sSESpecificationOverride :: Lens.Lens' RestoreTableToPointInTime (Prelude.Maybe SSESpecification)
restoreTableToPointInTime_sSESpecificationOverride :: Lens' RestoreTableToPointInTime (Maybe SSESpecification)
restoreTableToPointInTime_sSESpecificationOverride = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreTableToPointInTime' {Maybe SSESpecification
sSESpecificationOverride :: Maybe SSESpecification
$sel:sSESpecificationOverride:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe SSESpecification
sSESpecificationOverride} -> Maybe SSESpecification
sSESpecificationOverride) (\s :: RestoreTableToPointInTime
s@RestoreTableToPointInTime' {} Maybe SSESpecification
a -> RestoreTableToPointInTime
s {$sel:sSESpecificationOverride:RestoreTableToPointInTime' :: Maybe SSESpecification
sSESpecificationOverride = Maybe SSESpecification
a} :: RestoreTableToPointInTime)

-- | The DynamoDB table that will be restored. This value is an Amazon
-- Resource Name (ARN).
restoreTableToPointInTime_sourceTableArn :: Lens.Lens' RestoreTableToPointInTime (Prelude.Maybe Prelude.Text)
restoreTableToPointInTime_sourceTableArn :: Lens' RestoreTableToPointInTime (Maybe Text)
restoreTableToPointInTime_sourceTableArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreTableToPointInTime' {Maybe Text
sourceTableArn :: Maybe Text
$sel:sourceTableArn:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe Text
sourceTableArn} -> Maybe Text
sourceTableArn) (\s :: RestoreTableToPointInTime
s@RestoreTableToPointInTime' {} Maybe Text
a -> RestoreTableToPointInTime
s {$sel:sourceTableArn:RestoreTableToPointInTime' :: Maybe Text
sourceTableArn = Maybe Text
a} :: RestoreTableToPointInTime)

-- | Name of the source table that is being restored.
restoreTableToPointInTime_sourceTableName :: Lens.Lens' RestoreTableToPointInTime (Prelude.Maybe Prelude.Text)
restoreTableToPointInTime_sourceTableName :: Lens' RestoreTableToPointInTime (Maybe Text)
restoreTableToPointInTime_sourceTableName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreTableToPointInTime' {Maybe Text
sourceTableName :: Maybe Text
$sel:sourceTableName:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe Text
sourceTableName} -> Maybe Text
sourceTableName) (\s :: RestoreTableToPointInTime
s@RestoreTableToPointInTime' {} Maybe Text
a -> RestoreTableToPointInTime
s {$sel:sourceTableName:RestoreTableToPointInTime' :: Maybe Text
sourceTableName = Maybe Text
a} :: RestoreTableToPointInTime)

-- | Restore the table to the latest possible time.
-- @LatestRestorableDateTime@ is typically 5 minutes before the current
-- time.
restoreTableToPointInTime_useLatestRestorableTime :: Lens.Lens' RestoreTableToPointInTime (Prelude.Maybe Prelude.Bool)
restoreTableToPointInTime_useLatestRestorableTime :: Lens' RestoreTableToPointInTime (Maybe Bool)
restoreTableToPointInTime_useLatestRestorableTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreTableToPointInTime' {Maybe Bool
useLatestRestorableTime :: Maybe Bool
$sel:useLatestRestorableTime:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe Bool
useLatestRestorableTime} -> Maybe Bool
useLatestRestorableTime) (\s :: RestoreTableToPointInTime
s@RestoreTableToPointInTime' {} Maybe Bool
a -> RestoreTableToPointInTime
s {$sel:useLatestRestorableTime:RestoreTableToPointInTime' :: Maybe Bool
useLatestRestorableTime = Maybe Bool
a} :: RestoreTableToPointInTime)

-- | The name of the new table to which it must be restored to.
restoreTableToPointInTime_targetTableName :: Lens.Lens' RestoreTableToPointInTime Prelude.Text
restoreTableToPointInTime_targetTableName :: Lens' RestoreTableToPointInTime Text
restoreTableToPointInTime_targetTableName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreTableToPointInTime' {Text
targetTableName :: Text
$sel:targetTableName:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Text
targetTableName} -> Text
targetTableName) (\s :: RestoreTableToPointInTime
s@RestoreTableToPointInTime' {} Text
a -> RestoreTableToPointInTime
s {$sel:targetTableName:RestoreTableToPointInTime' :: Text
targetTableName = Text
a} :: RestoreTableToPointInTime)

instance Core.AWSRequest RestoreTableToPointInTime where
  type
    AWSResponse RestoreTableToPointInTime =
      RestoreTableToPointInTimeResponse
  request :: (Service -> Service)
-> RestoreTableToPointInTime -> Request RestoreTableToPointInTime
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy RestoreTableToPointInTime
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RestoreTableToPointInTime)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe TableDescription -> Int -> RestoreTableToPointInTimeResponse
RestoreTableToPointInTimeResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"TableDescription")
            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 RestoreTableToPointInTime where
  hashWithSalt :: Int -> RestoreTableToPointInTime -> Int
hashWithSalt Int
_salt RestoreTableToPointInTime' {Maybe Bool
Maybe [LocalSecondaryIndex]
Maybe [GlobalSecondaryIndex]
Maybe Text
Maybe POSIX
Maybe SSESpecification
Maybe ProvisionedThroughput
Maybe BillingMode
Text
targetTableName :: Text
useLatestRestorableTime :: Maybe Bool
sourceTableName :: Maybe Text
sourceTableArn :: Maybe Text
sSESpecificationOverride :: Maybe SSESpecification
restoreDateTime :: Maybe POSIX
provisionedThroughputOverride :: Maybe ProvisionedThroughput
localSecondaryIndexOverride :: Maybe [LocalSecondaryIndex]
globalSecondaryIndexOverride :: Maybe [GlobalSecondaryIndex]
billingModeOverride :: Maybe BillingMode
$sel:targetTableName:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Text
$sel:useLatestRestorableTime:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe Bool
$sel:sourceTableName:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe Text
$sel:sourceTableArn:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe Text
$sel:sSESpecificationOverride:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe SSESpecification
$sel:restoreDateTime:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe POSIX
$sel:provisionedThroughputOverride:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe ProvisionedThroughput
$sel:localSecondaryIndexOverride:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe [LocalSecondaryIndex]
$sel:globalSecondaryIndexOverride:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe [GlobalSecondaryIndex]
$sel:billingModeOverride:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe BillingMode
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BillingMode
billingModeOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [GlobalSecondaryIndex]
globalSecondaryIndexOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [LocalSecondaryIndex]
localSecondaryIndexOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ProvisionedThroughput
provisionedThroughputOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
restoreDateTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SSESpecification
sSESpecificationOverride
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sourceTableArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sourceTableName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
useLatestRestorableTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
targetTableName

instance Prelude.NFData RestoreTableToPointInTime where
  rnf :: RestoreTableToPointInTime -> ()
rnf RestoreTableToPointInTime' {Maybe Bool
Maybe [LocalSecondaryIndex]
Maybe [GlobalSecondaryIndex]
Maybe Text
Maybe POSIX
Maybe SSESpecification
Maybe ProvisionedThroughput
Maybe BillingMode
Text
targetTableName :: Text
useLatestRestorableTime :: Maybe Bool
sourceTableName :: Maybe Text
sourceTableArn :: Maybe Text
sSESpecificationOverride :: Maybe SSESpecification
restoreDateTime :: Maybe POSIX
provisionedThroughputOverride :: Maybe ProvisionedThroughput
localSecondaryIndexOverride :: Maybe [LocalSecondaryIndex]
globalSecondaryIndexOverride :: Maybe [GlobalSecondaryIndex]
billingModeOverride :: Maybe BillingMode
$sel:targetTableName:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Text
$sel:useLatestRestorableTime:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe Bool
$sel:sourceTableName:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe Text
$sel:sourceTableArn:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe Text
$sel:sSESpecificationOverride:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe SSESpecification
$sel:restoreDateTime:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe POSIX
$sel:provisionedThroughputOverride:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe ProvisionedThroughput
$sel:localSecondaryIndexOverride:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe [LocalSecondaryIndex]
$sel:globalSecondaryIndexOverride:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe [GlobalSecondaryIndex]
$sel:billingModeOverride:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe BillingMode
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe BillingMode
billingModeOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [GlobalSecondaryIndex]
globalSecondaryIndexOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [LocalSecondaryIndex]
localSecondaryIndexOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ProvisionedThroughput
provisionedThroughputOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
restoreDateTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SSESpecification
sSESpecificationOverride
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceTableArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceTableName
      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 Text
targetTableName

instance Data.ToHeaders RestoreTableToPointInTime where
  toHeaders :: RestoreTableToPointInTime -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"DynamoDB_20120810.RestoreTableToPointInTime" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON RestoreTableToPointInTime where
  toJSON :: RestoreTableToPointInTime -> Value
toJSON RestoreTableToPointInTime' {Maybe Bool
Maybe [LocalSecondaryIndex]
Maybe [GlobalSecondaryIndex]
Maybe Text
Maybe POSIX
Maybe SSESpecification
Maybe ProvisionedThroughput
Maybe BillingMode
Text
targetTableName :: Text
useLatestRestorableTime :: Maybe Bool
sourceTableName :: Maybe Text
sourceTableArn :: Maybe Text
sSESpecificationOverride :: Maybe SSESpecification
restoreDateTime :: Maybe POSIX
provisionedThroughputOverride :: Maybe ProvisionedThroughput
localSecondaryIndexOverride :: Maybe [LocalSecondaryIndex]
globalSecondaryIndexOverride :: Maybe [GlobalSecondaryIndex]
billingModeOverride :: Maybe BillingMode
$sel:targetTableName:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Text
$sel:useLatestRestorableTime:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe Bool
$sel:sourceTableName:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe Text
$sel:sourceTableArn:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe Text
$sel:sSESpecificationOverride:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe SSESpecification
$sel:restoreDateTime:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe POSIX
$sel:provisionedThroughputOverride:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe ProvisionedThroughput
$sel:localSecondaryIndexOverride:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe [LocalSecondaryIndex]
$sel:globalSecondaryIndexOverride:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe [GlobalSecondaryIndex]
$sel:billingModeOverride:RestoreTableToPointInTime' :: RestoreTableToPointInTime -> Maybe BillingMode
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"BillingModeOverride" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe BillingMode
billingModeOverride,
            (Key
"GlobalSecondaryIndexOverride" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [GlobalSecondaryIndex]
globalSecondaryIndexOverride,
            (Key
"LocalSecondaryIndexOverride" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [LocalSecondaryIndex]
localSecondaryIndexOverride,
            (Key
"ProvisionedThroughputOverride" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ProvisionedThroughput
provisionedThroughputOverride,
            (Key
"RestoreDateTime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe POSIX
restoreDateTime,
            (Key
"SSESpecificationOverride" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe SSESpecification
sSESpecificationOverride,
            (Key
"SourceTableArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
sourceTableArn,
            (Key
"SourceTableName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
sourceTableName,
            (Key
"UseLatestRestorableTime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
useLatestRestorableTime,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"TargetTableName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
targetTableName)
          ]
      )

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

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

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

-- |
-- Create a value of 'RestoreTableToPointInTimeResponse' 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:
--
-- 'tableDescription', 'restoreTableToPointInTimeResponse_tableDescription' - Represents the properties of a table.
--
-- 'httpStatus', 'restoreTableToPointInTimeResponse_httpStatus' - The response's http status code.
newRestoreTableToPointInTimeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RestoreTableToPointInTimeResponse
newRestoreTableToPointInTimeResponse :: Int -> RestoreTableToPointInTimeResponse
newRestoreTableToPointInTimeResponse Int
pHttpStatus_ =
  RestoreTableToPointInTimeResponse'
    { $sel:tableDescription:RestoreTableToPointInTimeResponse' :: Maybe TableDescription
tableDescription =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RestoreTableToPointInTimeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Represents the properties of a table.
restoreTableToPointInTimeResponse_tableDescription :: Lens.Lens' RestoreTableToPointInTimeResponse (Prelude.Maybe TableDescription)
restoreTableToPointInTimeResponse_tableDescription :: Lens' RestoreTableToPointInTimeResponse (Maybe TableDescription)
restoreTableToPointInTimeResponse_tableDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RestoreTableToPointInTimeResponse' {Maybe TableDescription
tableDescription :: Maybe TableDescription
$sel:tableDescription:RestoreTableToPointInTimeResponse' :: RestoreTableToPointInTimeResponse -> Maybe TableDescription
tableDescription} -> Maybe TableDescription
tableDescription) (\s :: RestoreTableToPointInTimeResponse
s@RestoreTableToPointInTimeResponse' {} Maybe TableDescription
a -> RestoreTableToPointInTimeResponse
s {$sel:tableDescription:RestoreTableToPointInTimeResponse' :: Maybe TableDescription
tableDescription = Maybe TableDescription
a} :: RestoreTableToPointInTimeResponse)

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

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