{-# 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.TimeStreamWrite.UpdateTable
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modifies the retention duration of the memory store and magnetic store
-- for your Timestream table. Note that the change in retention duration
-- takes effect immediately. For example, if the retention period of the
-- memory store was initially set to 2 hours and then changed to 24 hours,
-- the memory store will be capable of holding 24 hours of data, but will
-- be populated with 24 hours of data 22 hours after this change was made.
-- Timestream does not retrieve data from the magnetic store to populate
-- the memory store.
--
-- See
-- <https://docs.aws.amazon.com/timestream/latest/developerguide/code-samples.update-table.html code sample>
-- for details.
module Amazonka.TimeStreamWrite.UpdateTable
  ( -- * Creating a Request
    UpdateTable (..),
    newUpdateTable,

    -- * Request Lenses
    updateTable_magneticStoreWriteProperties,
    updateTable_retentionProperties,
    updateTable_databaseName,
    updateTable_tableName,

    -- * Destructuring the Response
    UpdateTableResponse (..),
    newUpdateTableResponse,

    -- * Response Lenses
    updateTableResponse_table,
    updateTableResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateTable' smart constructor.
data UpdateTable = UpdateTable'
  { -- | Contains properties to set on the table when enabling magnetic store
    -- writes.
    UpdateTable -> Maybe MagneticStoreWriteProperties
magneticStoreWriteProperties :: Prelude.Maybe MagneticStoreWriteProperties,
    -- | The retention duration of the memory store and the magnetic store.
    UpdateTable -> Maybe RetentionProperties
retentionProperties :: Prelude.Maybe RetentionProperties,
    -- | The name of the Timestream database.
    UpdateTable -> Text
databaseName :: Prelude.Text,
    -- | The name of the Timestream table.
    UpdateTable -> Text
tableName :: Prelude.Text
  }
  deriving (UpdateTable -> UpdateTable -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateTable -> UpdateTable -> Bool
$c/= :: UpdateTable -> UpdateTable -> Bool
== :: UpdateTable -> UpdateTable -> Bool
$c== :: UpdateTable -> UpdateTable -> Bool
Prelude.Eq, ReadPrec [UpdateTable]
ReadPrec UpdateTable
Int -> ReadS UpdateTable
ReadS [UpdateTable]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateTable]
$creadListPrec :: ReadPrec [UpdateTable]
readPrec :: ReadPrec UpdateTable
$creadPrec :: ReadPrec UpdateTable
readList :: ReadS [UpdateTable]
$creadList :: ReadS [UpdateTable]
readsPrec :: Int -> ReadS UpdateTable
$creadsPrec :: Int -> ReadS UpdateTable
Prelude.Read, Int -> UpdateTable -> ShowS
[UpdateTable] -> ShowS
UpdateTable -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateTable] -> ShowS
$cshowList :: [UpdateTable] -> ShowS
show :: UpdateTable -> String
$cshow :: UpdateTable -> String
showsPrec :: Int -> UpdateTable -> ShowS
$cshowsPrec :: Int -> UpdateTable -> ShowS
Prelude.Show, forall x. Rep UpdateTable x -> UpdateTable
forall x. UpdateTable -> Rep UpdateTable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateTable x -> UpdateTable
$cfrom :: forall x. UpdateTable -> Rep UpdateTable x
Prelude.Generic)

-- |
-- Create a value of 'UpdateTable' 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:
--
-- 'magneticStoreWriteProperties', 'updateTable_magneticStoreWriteProperties' - Contains properties to set on the table when enabling magnetic store
-- writes.
--
-- 'retentionProperties', 'updateTable_retentionProperties' - The retention duration of the memory store and the magnetic store.
--
-- 'databaseName', 'updateTable_databaseName' - The name of the Timestream database.
--
-- 'tableName', 'updateTable_tableName' - The name of the Timestream table.
newUpdateTable ::
  -- | 'databaseName'
  Prelude.Text ->
  -- | 'tableName'
  Prelude.Text ->
  UpdateTable
newUpdateTable :: Text -> Text -> UpdateTable
newUpdateTable Text
pDatabaseName_ Text
pTableName_ =
  UpdateTable'
    { $sel:magneticStoreWriteProperties:UpdateTable' :: Maybe MagneticStoreWriteProperties
magneticStoreWriteProperties =
        forall a. Maybe a
Prelude.Nothing,
      $sel:retentionProperties:UpdateTable' :: Maybe RetentionProperties
retentionProperties = forall a. Maybe a
Prelude.Nothing,
      $sel:databaseName:UpdateTable' :: Text
databaseName = Text
pDatabaseName_,
      $sel:tableName:UpdateTable' :: Text
tableName = Text
pTableName_
    }

-- | Contains properties to set on the table when enabling magnetic store
-- writes.
updateTable_magneticStoreWriteProperties :: Lens.Lens' UpdateTable (Prelude.Maybe MagneticStoreWriteProperties)
updateTable_magneticStoreWriteProperties :: Lens' UpdateTable (Maybe MagneticStoreWriteProperties)
updateTable_magneticStoreWriteProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTable' {Maybe MagneticStoreWriteProperties
magneticStoreWriteProperties :: Maybe MagneticStoreWriteProperties
$sel:magneticStoreWriteProperties:UpdateTable' :: UpdateTable -> Maybe MagneticStoreWriteProperties
magneticStoreWriteProperties} -> Maybe MagneticStoreWriteProperties
magneticStoreWriteProperties) (\s :: UpdateTable
s@UpdateTable' {} Maybe MagneticStoreWriteProperties
a -> UpdateTable
s {$sel:magneticStoreWriteProperties:UpdateTable' :: Maybe MagneticStoreWriteProperties
magneticStoreWriteProperties = Maybe MagneticStoreWriteProperties
a} :: UpdateTable)

-- | The retention duration of the memory store and the magnetic store.
updateTable_retentionProperties :: Lens.Lens' UpdateTable (Prelude.Maybe RetentionProperties)
updateTable_retentionProperties :: Lens' UpdateTable (Maybe RetentionProperties)
updateTable_retentionProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTable' {Maybe RetentionProperties
retentionProperties :: Maybe RetentionProperties
$sel:retentionProperties:UpdateTable' :: UpdateTable -> Maybe RetentionProperties
retentionProperties} -> Maybe RetentionProperties
retentionProperties) (\s :: UpdateTable
s@UpdateTable' {} Maybe RetentionProperties
a -> UpdateTable
s {$sel:retentionProperties:UpdateTable' :: Maybe RetentionProperties
retentionProperties = Maybe RetentionProperties
a} :: UpdateTable)

-- | The name of the Timestream database.
updateTable_databaseName :: Lens.Lens' UpdateTable Prelude.Text
updateTable_databaseName :: Lens' UpdateTable Text
updateTable_databaseName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTable' {Text
databaseName :: Text
$sel:databaseName:UpdateTable' :: UpdateTable -> Text
databaseName} -> Text
databaseName) (\s :: UpdateTable
s@UpdateTable' {} Text
a -> UpdateTable
s {$sel:databaseName:UpdateTable' :: Text
databaseName = Text
a} :: UpdateTable)

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

instance Core.AWSRequest UpdateTable where
  type AWSResponse UpdateTable = UpdateTableResponse
  request :: (Service -> Service) -> UpdateTable -> Request UpdateTable
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 UpdateTable
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateTable)))
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 Table -> Int -> UpdateTableResponse
UpdateTableResponse'
            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
"Table")
            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 UpdateTable where
  hashWithSalt :: Int -> UpdateTable -> Int
hashWithSalt Int
_salt UpdateTable' {Maybe RetentionProperties
Maybe MagneticStoreWriteProperties
Text
tableName :: Text
databaseName :: Text
retentionProperties :: Maybe RetentionProperties
magneticStoreWriteProperties :: Maybe MagneticStoreWriteProperties
$sel:tableName:UpdateTable' :: UpdateTable -> Text
$sel:databaseName:UpdateTable' :: UpdateTable -> Text
$sel:retentionProperties:UpdateTable' :: UpdateTable -> Maybe RetentionProperties
$sel:magneticStoreWriteProperties:UpdateTable' :: UpdateTable -> Maybe MagneticStoreWriteProperties
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MagneticStoreWriteProperties
magneticStoreWriteProperties
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RetentionProperties
retentionProperties
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
databaseName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
tableName

instance Prelude.NFData UpdateTable where
  rnf :: UpdateTable -> ()
rnf UpdateTable' {Maybe RetentionProperties
Maybe MagneticStoreWriteProperties
Text
tableName :: Text
databaseName :: Text
retentionProperties :: Maybe RetentionProperties
magneticStoreWriteProperties :: Maybe MagneticStoreWriteProperties
$sel:tableName:UpdateTable' :: UpdateTable -> Text
$sel:databaseName:UpdateTable' :: UpdateTable -> Text
$sel:retentionProperties:UpdateTable' :: UpdateTable -> Maybe RetentionProperties
$sel:magneticStoreWriteProperties:UpdateTable' :: UpdateTable -> Maybe MagneticStoreWriteProperties
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe MagneticStoreWriteProperties
magneticStoreWriteProperties
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RetentionProperties
retentionProperties
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
databaseName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
tableName

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

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

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

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

-- |
-- Create a value of 'UpdateTableResponse' 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:
--
-- 'table', 'updateTableResponse_table' - The updated Timestream table.
--
-- 'httpStatus', 'updateTableResponse_httpStatus' - The response's http status code.
newUpdateTableResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateTableResponse
newUpdateTableResponse :: Int -> UpdateTableResponse
newUpdateTableResponse Int
pHttpStatus_ =
  UpdateTableResponse'
    { $sel:table:UpdateTableResponse' :: Maybe Table
table = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateTableResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The updated Timestream table.
updateTableResponse_table :: Lens.Lens' UpdateTableResponse (Prelude.Maybe Table)
updateTableResponse_table :: Lens' UpdateTableResponse (Maybe Table)
updateTableResponse_table = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTableResponse' {Maybe Table
table :: Maybe Table
$sel:table:UpdateTableResponse' :: UpdateTableResponse -> Maybe Table
table} -> Maybe Table
table) (\s :: UpdateTableResponse
s@UpdateTableResponse' {} Maybe Table
a -> UpdateTableResponse
s {$sel:table:UpdateTableResponse' :: Maybe Table
table = Maybe Table
a} :: UpdateTableResponse)

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

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