{-# 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.KeySpaces.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)
--
-- Adds new columns to the table or updates one of the table\'s settings,
-- for example capacity mode, encryption, point-in-time recovery, or ttl
-- settings. Note that you can only update one specific table setting per
-- update operation.
module Amazonka.KeySpaces.UpdateTable
  ( -- * Creating a Request
    UpdateTable (..),
    newUpdateTable,

    -- * Request Lenses
    updateTable_addColumns,
    updateTable_capacitySpecification,
    updateTable_defaultTimeToLive,
    updateTable_encryptionSpecification,
    updateTable_pointInTimeRecovery,
    updateTable_ttl,
    updateTable_keyspaceName,
    updateTable_tableName,

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

    -- * Response Lenses
    updateTableResponse_httpStatus,
    updateTableResponse_resourceArn,
  )
where

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

-- | /See:/ 'newUpdateTable' smart constructor.
data UpdateTable = UpdateTable'
  { -- | For each column to be added to the specified table:
    --
    -- • @name@ - The name of the column.
    --
    -- • @type@ - An Amazon Keyspaces data type. For more information, see
    -- <https://docs.aws.amazon.com/keyspaces/latest/devguide/cql.elements.html#cql.data-types Data types>
    -- in the /Amazon Keyspaces Developer Guide/.
    UpdateTable -> Maybe (NonEmpty ColumnDefinition)
addColumns :: Prelude.Maybe (Prelude.NonEmpty ColumnDefinition),
    -- | Modifies the read\/write throughput capacity mode for the table. The
    -- options are:
    --
    -- • @throughputMode:PAY_PER_REQUEST@ and
    --
    -- • @throughputMode:PROVISIONED@ - Provisioned capacity mode requires
    -- @readCapacityUnits@ and @writeCapacityUnits@ as input.
    --
    -- The default is @throughput_mode:PAY_PER_REQUEST@.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/keyspaces/latest/devguide/ReadWriteCapacityMode.html Read\/write capacity modes>
    -- in the /Amazon Keyspaces Developer Guide/.
    UpdateTable -> Maybe CapacitySpecification
capacitySpecification :: Prelude.Maybe CapacitySpecification,
    -- | The default Time to Live setting in seconds for the table.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/keyspaces/latest/devguide/TTL-how-it-works.html#ttl-howitworks_default_ttl Setting the default TTL value for a table>
    -- in the /Amazon Keyspaces Developer Guide/.
    UpdateTable -> Maybe Natural
defaultTimeToLive :: Prelude.Maybe Prelude.Natural,
    -- | Modifies the encryption settings of the table. You can choose one of the
    -- following KMS key (KMS key):
    --
    -- • @type:AWS_OWNED_KMS_KEY@ - This key is owned by Amazon Keyspaces.
    --
    -- • @type:CUSTOMER_MANAGED_KMS_KEY@ - This key is stored in your account
    -- and is created, owned, and managed by you. This option requires the
    -- @kms_key_identifier@ of the KMS key in Amazon Resource Name (ARN) format
    -- as input.
    --
    -- The default is @AWS_OWNED_KMS_KEY@.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/keyspaces/latest/devguide/EncryptionAtRest.html Encryption at rest>
    -- in the /Amazon Keyspaces Developer Guide/.
    UpdateTable -> Maybe EncryptionSpecification
encryptionSpecification :: Prelude.Maybe EncryptionSpecification,
    -- | Modifies the @pointInTimeRecovery@ settings of the table. The options
    -- are:
    --
    -- • @ENABLED@
    --
    -- • @DISABLED@
    --
    -- If it\'s not specified, the default is @DISABLED@.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/keyspaces/latest/devguide/PointInTimeRecovery.html Point-in-time recovery>
    -- in the /Amazon Keyspaces Developer Guide/.
    UpdateTable -> Maybe PointInTimeRecovery
pointInTimeRecovery :: Prelude.Maybe PointInTimeRecovery,
    -- | Modifies Time to Live custom settings for the table. The options are:
    --
    -- • @status:enabled@
    --
    -- • @status:disabled@
    --
    -- The default is @status:disabled@. After @ttl@ is enabled, you can\'t
    -- disable it for the table.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/keyspaces/latest/devguide/TTL.html Expiring data by using Amazon Keyspaces Time to Live (TTL)>
    -- in the /Amazon Keyspaces Developer Guide/.
    UpdateTable -> Maybe TimeToLive
ttl :: Prelude.Maybe TimeToLive,
    -- | The name of the keyspace the specified table is stored in.
    UpdateTable -> Text
keyspaceName :: Prelude.Text,
    -- | The name of the 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:
--
-- 'addColumns', 'updateTable_addColumns' - For each column to be added to the specified table:
--
-- • @name@ - The name of the column.
--
-- • @type@ - An Amazon Keyspaces data type. For more information, see
-- <https://docs.aws.amazon.com/keyspaces/latest/devguide/cql.elements.html#cql.data-types Data types>
-- in the /Amazon Keyspaces Developer Guide/.
--
-- 'capacitySpecification', 'updateTable_capacitySpecification' - Modifies the read\/write throughput capacity mode for the table. The
-- options are:
--
-- • @throughputMode:PAY_PER_REQUEST@ and
--
-- • @throughputMode:PROVISIONED@ - Provisioned capacity mode requires
-- @readCapacityUnits@ and @writeCapacityUnits@ as input.
--
-- The default is @throughput_mode:PAY_PER_REQUEST@.
--
-- For more information, see
-- <https://docs.aws.amazon.com/keyspaces/latest/devguide/ReadWriteCapacityMode.html Read\/write capacity modes>
-- in the /Amazon Keyspaces Developer Guide/.
--
-- 'defaultTimeToLive', 'updateTable_defaultTimeToLive' - The default Time to Live setting in seconds for the table.
--
-- For more information, see
-- <https://docs.aws.amazon.com/keyspaces/latest/devguide/TTL-how-it-works.html#ttl-howitworks_default_ttl Setting the default TTL value for a table>
-- in the /Amazon Keyspaces Developer Guide/.
--
-- 'encryptionSpecification', 'updateTable_encryptionSpecification' - Modifies the encryption settings of the table. You can choose one of the
-- following KMS key (KMS key):
--
-- • @type:AWS_OWNED_KMS_KEY@ - This key is owned by Amazon Keyspaces.
--
-- • @type:CUSTOMER_MANAGED_KMS_KEY@ - This key is stored in your account
-- and is created, owned, and managed by you. This option requires the
-- @kms_key_identifier@ of the KMS key in Amazon Resource Name (ARN) format
-- as input.
--
-- The default is @AWS_OWNED_KMS_KEY@.
--
-- For more information, see
-- <https://docs.aws.amazon.com/keyspaces/latest/devguide/EncryptionAtRest.html Encryption at rest>
-- in the /Amazon Keyspaces Developer Guide/.
--
-- 'pointInTimeRecovery', 'updateTable_pointInTimeRecovery' - Modifies the @pointInTimeRecovery@ settings of the table. The options
-- are:
--
-- • @ENABLED@
--
-- • @DISABLED@
--
-- If it\'s not specified, the default is @DISABLED@.
--
-- For more information, see
-- <https://docs.aws.amazon.com/keyspaces/latest/devguide/PointInTimeRecovery.html Point-in-time recovery>
-- in the /Amazon Keyspaces Developer Guide/.
--
-- 'ttl', 'updateTable_ttl' - Modifies Time to Live custom settings for the table. The options are:
--
-- • @status:enabled@
--
-- • @status:disabled@
--
-- The default is @status:disabled@. After @ttl@ is enabled, you can\'t
-- disable it for the table.
--
-- For more information, see
-- <https://docs.aws.amazon.com/keyspaces/latest/devguide/TTL.html Expiring data by using Amazon Keyspaces Time to Live (TTL)>
-- in the /Amazon Keyspaces Developer Guide/.
--
-- 'keyspaceName', 'updateTable_keyspaceName' - The name of the keyspace the specified table is stored in.
--
-- 'tableName', 'updateTable_tableName' - The name of the table.
newUpdateTable ::
  -- | 'keyspaceName'
  Prelude.Text ->
  -- | 'tableName'
  Prelude.Text ->
  UpdateTable
newUpdateTable :: Text -> Text -> UpdateTable
newUpdateTable Text
pKeyspaceName_ Text
pTableName_ =
  UpdateTable'
    { $sel:addColumns:UpdateTable' :: Maybe (NonEmpty ColumnDefinition)
addColumns = forall a. Maybe a
Prelude.Nothing,
      $sel:capacitySpecification:UpdateTable' :: Maybe CapacitySpecification
capacitySpecification = forall a. Maybe a
Prelude.Nothing,
      $sel:defaultTimeToLive:UpdateTable' :: Maybe Natural
defaultTimeToLive = forall a. Maybe a
Prelude.Nothing,
      $sel:encryptionSpecification:UpdateTable' :: Maybe EncryptionSpecification
encryptionSpecification = forall a. Maybe a
Prelude.Nothing,
      $sel:pointInTimeRecovery:UpdateTable' :: Maybe PointInTimeRecovery
pointInTimeRecovery = forall a. Maybe a
Prelude.Nothing,
      $sel:ttl:UpdateTable' :: Maybe TimeToLive
ttl = forall a. Maybe a
Prelude.Nothing,
      $sel:keyspaceName:UpdateTable' :: Text
keyspaceName = Text
pKeyspaceName_,
      $sel:tableName:UpdateTable' :: Text
tableName = Text
pTableName_
    }

-- | For each column to be added to the specified table:
--
-- • @name@ - The name of the column.
--
-- • @type@ - An Amazon Keyspaces data type. For more information, see
-- <https://docs.aws.amazon.com/keyspaces/latest/devguide/cql.elements.html#cql.data-types Data types>
-- in the /Amazon Keyspaces Developer Guide/.
updateTable_addColumns :: Lens.Lens' UpdateTable (Prelude.Maybe (Prelude.NonEmpty ColumnDefinition))
updateTable_addColumns :: Lens' UpdateTable (Maybe (NonEmpty ColumnDefinition))
updateTable_addColumns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTable' {Maybe (NonEmpty ColumnDefinition)
addColumns :: Maybe (NonEmpty ColumnDefinition)
$sel:addColumns:UpdateTable' :: UpdateTable -> Maybe (NonEmpty ColumnDefinition)
addColumns} -> Maybe (NonEmpty ColumnDefinition)
addColumns) (\s :: UpdateTable
s@UpdateTable' {} Maybe (NonEmpty ColumnDefinition)
a -> UpdateTable
s {$sel:addColumns:UpdateTable' :: Maybe (NonEmpty ColumnDefinition)
addColumns = Maybe (NonEmpty ColumnDefinition)
a} :: UpdateTable) 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

-- | Modifies the read\/write throughput capacity mode for the table. The
-- options are:
--
-- • @throughputMode:PAY_PER_REQUEST@ and
--
-- • @throughputMode:PROVISIONED@ - Provisioned capacity mode requires
-- @readCapacityUnits@ and @writeCapacityUnits@ as input.
--
-- The default is @throughput_mode:PAY_PER_REQUEST@.
--
-- For more information, see
-- <https://docs.aws.amazon.com/keyspaces/latest/devguide/ReadWriteCapacityMode.html Read\/write capacity modes>
-- in the /Amazon Keyspaces Developer Guide/.
updateTable_capacitySpecification :: Lens.Lens' UpdateTable (Prelude.Maybe CapacitySpecification)
updateTable_capacitySpecification :: Lens' UpdateTable (Maybe CapacitySpecification)
updateTable_capacitySpecification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTable' {Maybe CapacitySpecification
capacitySpecification :: Maybe CapacitySpecification
$sel:capacitySpecification:UpdateTable' :: UpdateTable -> Maybe CapacitySpecification
capacitySpecification} -> Maybe CapacitySpecification
capacitySpecification) (\s :: UpdateTable
s@UpdateTable' {} Maybe CapacitySpecification
a -> UpdateTable
s {$sel:capacitySpecification:UpdateTable' :: Maybe CapacitySpecification
capacitySpecification = Maybe CapacitySpecification
a} :: UpdateTable)

-- | The default Time to Live setting in seconds for the table.
--
-- For more information, see
-- <https://docs.aws.amazon.com/keyspaces/latest/devguide/TTL-how-it-works.html#ttl-howitworks_default_ttl Setting the default TTL value for a table>
-- in the /Amazon Keyspaces Developer Guide/.
updateTable_defaultTimeToLive :: Lens.Lens' UpdateTable (Prelude.Maybe Prelude.Natural)
updateTable_defaultTimeToLive :: Lens' UpdateTable (Maybe Natural)
updateTable_defaultTimeToLive = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTable' {Maybe Natural
defaultTimeToLive :: Maybe Natural
$sel:defaultTimeToLive:UpdateTable' :: UpdateTable -> Maybe Natural
defaultTimeToLive} -> Maybe Natural
defaultTimeToLive) (\s :: UpdateTable
s@UpdateTable' {} Maybe Natural
a -> UpdateTable
s {$sel:defaultTimeToLive:UpdateTable' :: Maybe Natural
defaultTimeToLive = Maybe Natural
a} :: UpdateTable)

-- | Modifies the encryption settings of the table. You can choose one of the
-- following KMS key (KMS key):
--
-- • @type:AWS_OWNED_KMS_KEY@ - This key is owned by Amazon Keyspaces.
--
-- • @type:CUSTOMER_MANAGED_KMS_KEY@ - This key is stored in your account
-- and is created, owned, and managed by you. This option requires the
-- @kms_key_identifier@ of the KMS key in Amazon Resource Name (ARN) format
-- as input.
--
-- The default is @AWS_OWNED_KMS_KEY@.
--
-- For more information, see
-- <https://docs.aws.amazon.com/keyspaces/latest/devguide/EncryptionAtRest.html Encryption at rest>
-- in the /Amazon Keyspaces Developer Guide/.
updateTable_encryptionSpecification :: Lens.Lens' UpdateTable (Prelude.Maybe EncryptionSpecification)
updateTable_encryptionSpecification :: Lens' UpdateTable (Maybe EncryptionSpecification)
updateTable_encryptionSpecification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTable' {Maybe EncryptionSpecification
encryptionSpecification :: Maybe EncryptionSpecification
$sel:encryptionSpecification:UpdateTable' :: UpdateTable -> Maybe EncryptionSpecification
encryptionSpecification} -> Maybe EncryptionSpecification
encryptionSpecification) (\s :: UpdateTable
s@UpdateTable' {} Maybe EncryptionSpecification
a -> UpdateTable
s {$sel:encryptionSpecification:UpdateTable' :: Maybe EncryptionSpecification
encryptionSpecification = Maybe EncryptionSpecification
a} :: UpdateTable)

-- | Modifies the @pointInTimeRecovery@ settings of the table. The options
-- are:
--
-- • @ENABLED@
--
-- • @DISABLED@
--
-- If it\'s not specified, the default is @DISABLED@.
--
-- For more information, see
-- <https://docs.aws.amazon.com/keyspaces/latest/devguide/PointInTimeRecovery.html Point-in-time recovery>
-- in the /Amazon Keyspaces Developer Guide/.
updateTable_pointInTimeRecovery :: Lens.Lens' UpdateTable (Prelude.Maybe PointInTimeRecovery)
updateTable_pointInTimeRecovery :: Lens' UpdateTable (Maybe PointInTimeRecovery)
updateTable_pointInTimeRecovery = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTable' {Maybe PointInTimeRecovery
pointInTimeRecovery :: Maybe PointInTimeRecovery
$sel:pointInTimeRecovery:UpdateTable' :: UpdateTable -> Maybe PointInTimeRecovery
pointInTimeRecovery} -> Maybe PointInTimeRecovery
pointInTimeRecovery) (\s :: UpdateTable
s@UpdateTable' {} Maybe PointInTimeRecovery
a -> UpdateTable
s {$sel:pointInTimeRecovery:UpdateTable' :: Maybe PointInTimeRecovery
pointInTimeRecovery = Maybe PointInTimeRecovery
a} :: UpdateTable)

-- | Modifies Time to Live custom settings for the table. The options are:
--
-- • @status:enabled@
--
-- • @status:disabled@
--
-- The default is @status:disabled@. After @ttl@ is enabled, you can\'t
-- disable it for the table.
--
-- For more information, see
-- <https://docs.aws.amazon.com/keyspaces/latest/devguide/TTL.html Expiring data by using Amazon Keyspaces Time to Live (TTL)>
-- in the /Amazon Keyspaces Developer Guide/.
updateTable_ttl :: Lens.Lens' UpdateTable (Prelude.Maybe TimeToLive)
updateTable_ttl :: Lens' UpdateTable (Maybe TimeToLive)
updateTable_ttl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTable' {Maybe TimeToLive
ttl :: Maybe TimeToLive
$sel:ttl:UpdateTable' :: UpdateTable -> Maybe TimeToLive
ttl} -> Maybe TimeToLive
ttl) (\s :: UpdateTable
s@UpdateTable' {} Maybe TimeToLive
a -> UpdateTable
s {$sel:ttl:UpdateTable' :: Maybe TimeToLive
ttl = Maybe TimeToLive
a} :: UpdateTable)

-- | The name of the keyspace the specified table is stored in.
updateTable_keyspaceName :: Lens.Lens' UpdateTable Prelude.Text
updateTable_keyspaceName :: Lens' UpdateTable Text
updateTable_keyspaceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTable' {Text
keyspaceName :: Text
$sel:keyspaceName:UpdateTable' :: UpdateTable -> Text
keyspaceName} -> Text
keyspaceName) (\s :: UpdateTable
s@UpdateTable' {} Text
a -> UpdateTable
s {$sel:keyspaceName:UpdateTable' :: Text
keyspaceName = Text
a} :: UpdateTable)

-- | The name of the 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 ->
          Int -> Text -> UpdateTableResponse
UpdateTableResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"resourceArn")
      )

instance Prelude.Hashable UpdateTable where
  hashWithSalt :: Int -> UpdateTable -> Int
hashWithSalt Int
_salt UpdateTable' {Maybe Natural
Maybe (NonEmpty ColumnDefinition)
Maybe EncryptionSpecification
Maybe PointInTimeRecovery
Maybe CapacitySpecification
Maybe TimeToLive
Text
tableName :: Text
keyspaceName :: Text
ttl :: Maybe TimeToLive
pointInTimeRecovery :: Maybe PointInTimeRecovery
encryptionSpecification :: Maybe EncryptionSpecification
defaultTimeToLive :: Maybe Natural
capacitySpecification :: Maybe CapacitySpecification
addColumns :: Maybe (NonEmpty ColumnDefinition)
$sel:tableName:UpdateTable' :: UpdateTable -> Text
$sel:keyspaceName:UpdateTable' :: UpdateTable -> Text
$sel:ttl:UpdateTable' :: UpdateTable -> Maybe TimeToLive
$sel:pointInTimeRecovery:UpdateTable' :: UpdateTable -> Maybe PointInTimeRecovery
$sel:encryptionSpecification:UpdateTable' :: UpdateTable -> Maybe EncryptionSpecification
$sel:defaultTimeToLive:UpdateTable' :: UpdateTable -> Maybe Natural
$sel:capacitySpecification:UpdateTable' :: UpdateTable -> Maybe CapacitySpecification
$sel:addColumns:UpdateTable' :: UpdateTable -> Maybe (NonEmpty ColumnDefinition)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty ColumnDefinition)
addColumns
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CapacitySpecification
capacitySpecification
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
defaultTimeToLive
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EncryptionSpecification
encryptionSpecification
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PointInTimeRecovery
pointInTimeRecovery
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TimeToLive
ttl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
keyspaceName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
tableName

instance Prelude.NFData UpdateTable where
  rnf :: UpdateTable -> ()
rnf UpdateTable' {Maybe Natural
Maybe (NonEmpty ColumnDefinition)
Maybe EncryptionSpecification
Maybe PointInTimeRecovery
Maybe CapacitySpecification
Maybe TimeToLive
Text
tableName :: Text
keyspaceName :: Text
ttl :: Maybe TimeToLive
pointInTimeRecovery :: Maybe PointInTimeRecovery
encryptionSpecification :: Maybe EncryptionSpecification
defaultTimeToLive :: Maybe Natural
capacitySpecification :: Maybe CapacitySpecification
addColumns :: Maybe (NonEmpty ColumnDefinition)
$sel:tableName:UpdateTable' :: UpdateTable -> Text
$sel:keyspaceName:UpdateTable' :: UpdateTable -> Text
$sel:ttl:UpdateTable' :: UpdateTable -> Maybe TimeToLive
$sel:pointInTimeRecovery:UpdateTable' :: UpdateTable -> Maybe PointInTimeRecovery
$sel:encryptionSpecification:UpdateTable' :: UpdateTable -> Maybe EncryptionSpecification
$sel:defaultTimeToLive:UpdateTable' :: UpdateTable -> Maybe Natural
$sel:capacitySpecification:UpdateTable' :: UpdateTable -> Maybe CapacitySpecification
$sel:addColumns:UpdateTable' :: UpdateTable -> Maybe (NonEmpty ColumnDefinition)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty ColumnDefinition)
addColumns
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CapacitySpecification
capacitySpecification
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
defaultTimeToLive
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EncryptionSpecification
encryptionSpecification
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PointInTimeRecovery
pointInTimeRecovery
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TimeToLive
ttl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
keyspaceName
      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
"KeyspacesService.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 Natural
Maybe (NonEmpty ColumnDefinition)
Maybe EncryptionSpecification
Maybe PointInTimeRecovery
Maybe CapacitySpecification
Maybe TimeToLive
Text
tableName :: Text
keyspaceName :: Text
ttl :: Maybe TimeToLive
pointInTimeRecovery :: Maybe PointInTimeRecovery
encryptionSpecification :: Maybe EncryptionSpecification
defaultTimeToLive :: Maybe Natural
capacitySpecification :: Maybe CapacitySpecification
addColumns :: Maybe (NonEmpty ColumnDefinition)
$sel:tableName:UpdateTable' :: UpdateTable -> Text
$sel:keyspaceName:UpdateTable' :: UpdateTable -> Text
$sel:ttl:UpdateTable' :: UpdateTable -> Maybe TimeToLive
$sel:pointInTimeRecovery:UpdateTable' :: UpdateTable -> Maybe PointInTimeRecovery
$sel:encryptionSpecification:UpdateTable' :: UpdateTable -> Maybe EncryptionSpecification
$sel:defaultTimeToLive:UpdateTable' :: UpdateTable -> Maybe Natural
$sel:capacitySpecification:UpdateTable' :: UpdateTable -> Maybe CapacitySpecification
$sel:addColumns:UpdateTable' :: UpdateTable -> Maybe (NonEmpty ColumnDefinition)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"addColumns" 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 (NonEmpty ColumnDefinition)
addColumns,
            (Key
"capacitySpecification" 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 CapacitySpecification
capacitySpecification,
            (Key
"defaultTimeToLive" 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 Natural
defaultTimeToLive,
            (Key
"encryptionSpecification" 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 EncryptionSpecification
encryptionSpecification,
            (Key
"pointInTimeRecovery" 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 PointInTimeRecovery
pointInTimeRecovery,
            (Key
"ttl" 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 TimeToLive
ttl,
            forall a. a -> Maybe a
Prelude.Just (Key
"keyspaceName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
keyspaceName),
            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 response's http status code.
    UpdateTableResponse -> Int
httpStatus :: Prelude.Int,
    -- | The Amazon Resource Name (ARN) of the modified table.
    UpdateTableResponse -> Text
resourceArn :: Prelude.Text
  }
  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:
--
-- 'httpStatus', 'updateTableResponse_httpStatus' - The response's http status code.
--
-- 'resourceArn', 'updateTableResponse_resourceArn' - The Amazon Resource Name (ARN) of the modified table.
newUpdateTableResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'resourceArn'
  Prelude.Text ->
  UpdateTableResponse
newUpdateTableResponse :: Int -> Text -> UpdateTableResponse
newUpdateTableResponse Int
pHttpStatus_ Text
pResourceArn_ =
  UpdateTableResponse'
    { $sel:httpStatus:UpdateTableResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:resourceArn:UpdateTableResponse' :: Text
resourceArn = Text
pResourceArn_
    }

-- | 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)

-- | The Amazon Resource Name (ARN) of the modified table.
updateTableResponse_resourceArn :: Lens.Lens' UpdateTableResponse Prelude.Text
updateTableResponse_resourceArn :: Lens' UpdateTableResponse Text
updateTableResponse_resourceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTableResponse' {Text
resourceArn :: Text
$sel:resourceArn:UpdateTableResponse' :: UpdateTableResponse -> Text
resourceArn} -> Text
resourceArn) (\s :: UpdateTableResponse
s@UpdateTableResponse' {} Text
a -> UpdateTableResponse
s {$sel:resourceArn:UpdateTableResponse' :: Text
resourceArn = Text
a} :: UpdateTableResponse)

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