{-# 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.UpdateContinuousBackups
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- @UpdateContinuousBackups@ enables or disables point in time recovery for
-- the specified table. A successful @UpdateContinuousBackups@ call returns
-- the current @ContinuousBackupsDescription@. Continuous backups are
-- @ENABLED@ on all tables at table creation. If point in time recovery is
-- enabled, @PointInTimeRecoveryStatus@ will be set to ENABLED.
--
-- Once continuous backups and point in time recovery are enabled, you can
-- restore to any point in time within @EarliestRestorableDateTime@ and
-- @LatestRestorableDateTime@.
--
-- @LatestRestorableDateTime@ is typically 5 minutes before the current
-- time. You can restore your table to any point in time during the last 35
-- days.
module Amazonka.DynamoDB.UpdateContinuousBackups
  ( -- * Creating a Request
    UpdateContinuousBackups (..),
    newUpdateContinuousBackups,

    -- * Request Lenses
    updateContinuousBackups_tableName,
    updateContinuousBackups_pointInTimeRecoverySpecification,

    -- * Destructuring the Response
    UpdateContinuousBackupsResponse (..),
    newUpdateContinuousBackupsResponse,

    -- * Response Lenses
    updateContinuousBackupsResponse_continuousBackupsDescription,
    updateContinuousBackupsResponse_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:/ 'newUpdateContinuousBackups' smart constructor.
data UpdateContinuousBackups = UpdateContinuousBackups'
  { -- | The name of the table.
    UpdateContinuousBackups -> Text
tableName :: Prelude.Text,
    -- | Represents the settings used to enable point in time recovery.
    UpdateContinuousBackups -> PointInTimeRecoverySpecification
pointInTimeRecoverySpecification :: PointInTimeRecoverySpecification
  }
  deriving (UpdateContinuousBackups -> UpdateContinuousBackups -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateContinuousBackups -> UpdateContinuousBackups -> Bool
$c/= :: UpdateContinuousBackups -> UpdateContinuousBackups -> Bool
== :: UpdateContinuousBackups -> UpdateContinuousBackups -> Bool
$c== :: UpdateContinuousBackups -> UpdateContinuousBackups -> Bool
Prelude.Eq, ReadPrec [UpdateContinuousBackups]
ReadPrec UpdateContinuousBackups
Int -> ReadS UpdateContinuousBackups
ReadS [UpdateContinuousBackups]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateContinuousBackups]
$creadListPrec :: ReadPrec [UpdateContinuousBackups]
readPrec :: ReadPrec UpdateContinuousBackups
$creadPrec :: ReadPrec UpdateContinuousBackups
readList :: ReadS [UpdateContinuousBackups]
$creadList :: ReadS [UpdateContinuousBackups]
readsPrec :: Int -> ReadS UpdateContinuousBackups
$creadsPrec :: Int -> ReadS UpdateContinuousBackups
Prelude.Read, Int -> UpdateContinuousBackups -> ShowS
[UpdateContinuousBackups] -> ShowS
UpdateContinuousBackups -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateContinuousBackups] -> ShowS
$cshowList :: [UpdateContinuousBackups] -> ShowS
show :: UpdateContinuousBackups -> String
$cshow :: UpdateContinuousBackups -> String
showsPrec :: Int -> UpdateContinuousBackups -> ShowS
$cshowsPrec :: Int -> UpdateContinuousBackups -> ShowS
Prelude.Show, forall x. Rep UpdateContinuousBackups x -> UpdateContinuousBackups
forall x. UpdateContinuousBackups -> Rep UpdateContinuousBackups x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateContinuousBackups x -> UpdateContinuousBackups
$cfrom :: forall x. UpdateContinuousBackups -> Rep UpdateContinuousBackups x
Prelude.Generic)

-- |
-- Create a value of 'UpdateContinuousBackups' 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:
--
-- 'tableName', 'updateContinuousBackups_tableName' - The name of the table.
--
-- 'pointInTimeRecoverySpecification', 'updateContinuousBackups_pointInTimeRecoverySpecification' - Represents the settings used to enable point in time recovery.
newUpdateContinuousBackups ::
  -- | 'tableName'
  Prelude.Text ->
  -- | 'pointInTimeRecoverySpecification'
  PointInTimeRecoverySpecification ->
  UpdateContinuousBackups
newUpdateContinuousBackups :: Text -> PointInTimeRecoverySpecification -> UpdateContinuousBackups
newUpdateContinuousBackups
  Text
pTableName_
  PointInTimeRecoverySpecification
pPointInTimeRecoverySpecification_ =
    UpdateContinuousBackups'
      { $sel:tableName:UpdateContinuousBackups' :: Text
tableName = Text
pTableName_,
        $sel:pointInTimeRecoverySpecification:UpdateContinuousBackups' :: PointInTimeRecoverySpecification
pointInTimeRecoverySpecification =
          PointInTimeRecoverySpecification
pPointInTimeRecoverySpecification_
      }

-- | The name of the table.
updateContinuousBackups_tableName :: Lens.Lens' UpdateContinuousBackups Prelude.Text
updateContinuousBackups_tableName :: Lens' UpdateContinuousBackups Text
updateContinuousBackups_tableName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateContinuousBackups' {Text
tableName :: Text
$sel:tableName:UpdateContinuousBackups' :: UpdateContinuousBackups -> Text
tableName} -> Text
tableName) (\s :: UpdateContinuousBackups
s@UpdateContinuousBackups' {} Text
a -> UpdateContinuousBackups
s {$sel:tableName:UpdateContinuousBackups' :: Text
tableName = Text
a} :: UpdateContinuousBackups)

-- | Represents the settings used to enable point in time recovery.
updateContinuousBackups_pointInTimeRecoverySpecification :: Lens.Lens' UpdateContinuousBackups PointInTimeRecoverySpecification
updateContinuousBackups_pointInTimeRecoverySpecification :: Lens' UpdateContinuousBackups PointInTimeRecoverySpecification
updateContinuousBackups_pointInTimeRecoverySpecification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateContinuousBackups' {PointInTimeRecoverySpecification
pointInTimeRecoverySpecification :: PointInTimeRecoverySpecification
$sel:pointInTimeRecoverySpecification:UpdateContinuousBackups' :: UpdateContinuousBackups -> PointInTimeRecoverySpecification
pointInTimeRecoverySpecification} -> PointInTimeRecoverySpecification
pointInTimeRecoverySpecification) (\s :: UpdateContinuousBackups
s@UpdateContinuousBackups' {} PointInTimeRecoverySpecification
a -> UpdateContinuousBackups
s {$sel:pointInTimeRecoverySpecification:UpdateContinuousBackups' :: PointInTimeRecoverySpecification
pointInTimeRecoverySpecification = PointInTimeRecoverySpecification
a} :: UpdateContinuousBackups)

instance Core.AWSRequest UpdateContinuousBackups where
  type
    AWSResponse UpdateContinuousBackups =
      UpdateContinuousBackupsResponse
  request :: (Service -> Service)
-> UpdateContinuousBackups -> Request UpdateContinuousBackups
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 UpdateContinuousBackups
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateContinuousBackups)))
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 ContinuousBackupsDescription
-> Int -> UpdateContinuousBackupsResponse
UpdateContinuousBackupsResponse'
            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
"ContinuousBackupsDescription")
            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 UpdateContinuousBackups where
  hashWithSalt :: Int -> UpdateContinuousBackups -> Int
hashWithSalt Int
_salt UpdateContinuousBackups' {Text
PointInTimeRecoverySpecification
pointInTimeRecoverySpecification :: PointInTimeRecoverySpecification
tableName :: Text
$sel:pointInTimeRecoverySpecification:UpdateContinuousBackups' :: UpdateContinuousBackups -> PointInTimeRecoverySpecification
$sel:tableName:UpdateContinuousBackups' :: UpdateContinuousBackups -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
tableName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` PointInTimeRecoverySpecification
pointInTimeRecoverySpecification

instance Prelude.NFData UpdateContinuousBackups where
  rnf :: UpdateContinuousBackups -> ()
rnf UpdateContinuousBackups' {Text
PointInTimeRecoverySpecification
pointInTimeRecoverySpecification :: PointInTimeRecoverySpecification
tableName :: Text
$sel:pointInTimeRecoverySpecification:UpdateContinuousBackups' :: UpdateContinuousBackups -> PointInTimeRecoverySpecification
$sel:tableName:UpdateContinuousBackups' :: UpdateContinuousBackups -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
tableName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf PointInTimeRecoverySpecification
pointInTimeRecoverySpecification

instance Data.ToHeaders UpdateContinuousBackups where
  toHeaders :: UpdateContinuousBackups -> 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.UpdateContinuousBackups" ::
                          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 UpdateContinuousBackups where
  toJSON :: UpdateContinuousBackups -> Value
toJSON UpdateContinuousBackups' {Text
PointInTimeRecoverySpecification
pointInTimeRecoverySpecification :: PointInTimeRecoverySpecification
tableName :: Text
$sel:pointInTimeRecoverySpecification:UpdateContinuousBackups' :: UpdateContinuousBackups -> PointInTimeRecoverySpecification
$sel:tableName:UpdateContinuousBackups' :: UpdateContinuousBackups -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"TableName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
tableName),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"PointInTimeRecoverySpecification"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= PointInTimeRecoverySpecification
pointInTimeRecoverySpecification
              )
          ]
      )

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

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

-- | /See:/ 'newUpdateContinuousBackupsResponse' smart constructor.
data UpdateContinuousBackupsResponse = UpdateContinuousBackupsResponse'
  { -- | Represents the continuous backups and point in time recovery settings on
    -- the table.
    UpdateContinuousBackupsResponse
-> Maybe ContinuousBackupsDescription
continuousBackupsDescription :: Prelude.Maybe ContinuousBackupsDescription,
    -- | The response's http status code.
    UpdateContinuousBackupsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateContinuousBackupsResponse
-> UpdateContinuousBackupsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateContinuousBackupsResponse
-> UpdateContinuousBackupsResponse -> Bool
$c/= :: UpdateContinuousBackupsResponse
-> UpdateContinuousBackupsResponse -> Bool
== :: UpdateContinuousBackupsResponse
-> UpdateContinuousBackupsResponse -> Bool
$c== :: UpdateContinuousBackupsResponse
-> UpdateContinuousBackupsResponse -> Bool
Prelude.Eq, ReadPrec [UpdateContinuousBackupsResponse]
ReadPrec UpdateContinuousBackupsResponse
Int -> ReadS UpdateContinuousBackupsResponse
ReadS [UpdateContinuousBackupsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateContinuousBackupsResponse]
$creadListPrec :: ReadPrec [UpdateContinuousBackupsResponse]
readPrec :: ReadPrec UpdateContinuousBackupsResponse
$creadPrec :: ReadPrec UpdateContinuousBackupsResponse
readList :: ReadS [UpdateContinuousBackupsResponse]
$creadList :: ReadS [UpdateContinuousBackupsResponse]
readsPrec :: Int -> ReadS UpdateContinuousBackupsResponse
$creadsPrec :: Int -> ReadS UpdateContinuousBackupsResponse
Prelude.Read, Int -> UpdateContinuousBackupsResponse -> ShowS
[UpdateContinuousBackupsResponse] -> ShowS
UpdateContinuousBackupsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateContinuousBackupsResponse] -> ShowS
$cshowList :: [UpdateContinuousBackupsResponse] -> ShowS
show :: UpdateContinuousBackupsResponse -> String
$cshow :: UpdateContinuousBackupsResponse -> String
showsPrec :: Int -> UpdateContinuousBackupsResponse -> ShowS
$cshowsPrec :: Int -> UpdateContinuousBackupsResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateContinuousBackupsResponse x
-> UpdateContinuousBackupsResponse
forall x.
UpdateContinuousBackupsResponse
-> Rep UpdateContinuousBackupsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateContinuousBackupsResponse x
-> UpdateContinuousBackupsResponse
$cfrom :: forall x.
UpdateContinuousBackupsResponse
-> Rep UpdateContinuousBackupsResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateContinuousBackupsResponse' 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:
--
-- 'continuousBackupsDescription', 'updateContinuousBackupsResponse_continuousBackupsDescription' - Represents the continuous backups and point in time recovery settings on
-- the table.
--
-- 'httpStatus', 'updateContinuousBackupsResponse_httpStatus' - The response's http status code.
newUpdateContinuousBackupsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateContinuousBackupsResponse
newUpdateContinuousBackupsResponse :: Int -> UpdateContinuousBackupsResponse
newUpdateContinuousBackupsResponse Int
pHttpStatus_ =
  UpdateContinuousBackupsResponse'
    { $sel:continuousBackupsDescription:UpdateContinuousBackupsResponse' :: Maybe ContinuousBackupsDescription
continuousBackupsDescription =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateContinuousBackupsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Represents the continuous backups and point in time recovery settings on
-- the table.
updateContinuousBackupsResponse_continuousBackupsDescription :: Lens.Lens' UpdateContinuousBackupsResponse (Prelude.Maybe ContinuousBackupsDescription)
updateContinuousBackupsResponse_continuousBackupsDescription :: Lens'
  UpdateContinuousBackupsResponse
  (Maybe ContinuousBackupsDescription)
updateContinuousBackupsResponse_continuousBackupsDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateContinuousBackupsResponse' {Maybe ContinuousBackupsDescription
continuousBackupsDescription :: Maybe ContinuousBackupsDescription
$sel:continuousBackupsDescription:UpdateContinuousBackupsResponse' :: UpdateContinuousBackupsResponse
-> Maybe ContinuousBackupsDescription
continuousBackupsDescription} -> Maybe ContinuousBackupsDescription
continuousBackupsDescription) (\s :: UpdateContinuousBackupsResponse
s@UpdateContinuousBackupsResponse' {} Maybe ContinuousBackupsDescription
a -> UpdateContinuousBackupsResponse
s {$sel:continuousBackupsDescription:UpdateContinuousBackupsResponse' :: Maybe ContinuousBackupsDescription
continuousBackupsDescription = Maybe ContinuousBackupsDescription
a} :: UpdateContinuousBackupsResponse)

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

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