{-# 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.GetTable
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns information about the table, including the table\'s name and
-- current status, the keyspace name, configuration settings, and metadata.
--
-- To read table metadata using @GetTable@, @Select@ action permissions for
-- the table and system tables are required to complete the operation.
module Amazonka.KeySpaces.GetTable
  ( -- * Creating a Request
    GetTable (..),
    newGetTable,

    -- * Request Lenses
    getTable_keyspaceName,
    getTable_tableName,

    -- * Destructuring the Response
    GetTableResponse (..),
    newGetTableResponse,

    -- * Response Lenses
    getTableResponse_capacitySpecification,
    getTableResponse_comment,
    getTableResponse_creationTimestamp,
    getTableResponse_defaultTimeToLive,
    getTableResponse_encryptionSpecification,
    getTableResponse_pointInTimeRecovery,
    getTableResponse_schemaDefinition,
    getTableResponse_status,
    getTableResponse_ttl,
    getTableResponse_httpStatus,
    getTableResponse_keyspaceName,
    getTableResponse_tableName,
    getTableResponse_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:/ 'newGetTable' smart constructor.
data GetTable = GetTable'
  { -- | The name of the keyspace that the table is stored in.
    GetTable -> Text
keyspaceName :: Prelude.Text,
    -- | The name of the table.
    GetTable -> Text
tableName :: Prelude.Text
  }
  deriving (GetTable -> GetTable -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetTable -> GetTable -> Bool
$c/= :: GetTable -> GetTable -> Bool
== :: GetTable -> GetTable -> Bool
$c== :: GetTable -> GetTable -> Bool
Prelude.Eq, ReadPrec [GetTable]
ReadPrec GetTable
Int -> ReadS GetTable
ReadS [GetTable]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetTable]
$creadListPrec :: ReadPrec [GetTable]
readPrec :: ReadPrec GetTable
$creadPrec :: ReadPrec GetTable
readList :: ReadS [GetTable]
$creadList :: ReadS [GetTable]
readsPrec :: Int -> ReadS GetTable
$creadsPrec :: Int -> ReadS GetTable
Prelude.Read, Int -> GetTable -> ShowS
[GetTable] -> ShowS
GetTable -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetTable] -> ShowS
$cshowList :: [GetTable] -> ShowS
show :: GetTable -> String
$cshow :: GetTable -> String
showsPrec :: Int -> GetTable -> ShowS
$cshowsPrec :: Int -> GetTable -> ShowS
Prelude.Show, forall x. Rep GetTable x -> GetTable
forall x. GetTable -> Rep GetTable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetTable x -> GetTable
$cfrom :: forall x. GetTable -> Rep GetTable x
Prelude.Generic)

-- |
-- Create a value of 'GetTable' 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:
--
-- 'keyspaceName', 'getTable_keyspaceName' - The name of the keyspace that the table is stored in.
--
-- 'tableName', 'getTable_tableName' - The name of the table.
newGetTable ::
  -- | 'keyspaceName'
  Prelude.Text ->
  -- | 'tableName'
  Prelude.Text ->
  GetTable
newGetTable :: Text -> Text -> GetTable
newGetTable Text
pKeyspaceName_ Text
pTableName_ =
  GetTable'
    { $sel:keyspaceName:GetTable' :: Text
keyspaceName = Text
pKeyspaceName_,
      $sel:tableName:GetTable' :: Text
tableName = Text
pTableName_
    }

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

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

instance Core.AWSRequest GetTable where
  type AWSResponse GetTable = GetTableResponse
  request :: (Service -> Service) -> GetTable -> Request GetTable
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 GetTable
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetTable)))
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 CapacitySpecificationSummary
-> Maybe Comment
-> Maybe POSIX
-> Maybe Natural
-> Maybe EncryptionSpecification
-> Maybe PointInTimeRecoverySummary
-> Maybe SchemaDefinition
-> Maybe TableStatus
-> Maybe TimeToLive
-> Int
-> Text
-> Text
-> Text
-> GetTableResponse
GetTableResponse'
            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
"capacitySpecification")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"comment")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"creationTimestamp")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"defaultTimeToLive")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"encryptionSpecification")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"pointInTimeRecovery")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"schemaDefinition")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"status")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ttl")
            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))
            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
"keyspaceName")
            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
"tableName")
            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 GetTable where
  hashWithSalt :: Int -> GetTable -> Int
hashWithSalt Int
_salt GetTable' {Text
tableName :: Text
keyspaceName :: Text
$sel:tableName:GetTable' :: GetTable -> Text
$sel:keyspaceName:GetTable' :: GetTable -> Text
..} =
    Int
_salt
      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 GetTable where
  rnf :: GetTable -> ()
rnf GetTable' {Text
tableName :: Text
keyspaceName :: Text
$sel:tableName:GetTable' :: GetTable -> Text
$sel:keyspaceName:GetTable' :: GetTable -> Text
..} =
    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 GetTable where
  toHeaders :: GetTable -> 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.GetTable" :: 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 GetTable where
  toJSON :: GetTable -> Value
toJSON GetTable' {Text
tableName :: Text
keyspaceName :: Text
$sel:tableName:GetTable' :: GetTable -> Text
$sel:keyspaceName:GetTable' :: GetTable -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ 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 GetTable where
  toPath :: GetTable -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newGetTableResponse' smart constructor.
data GetTableResponse = GetTableResponse'
  { -- | The read\/write throughput capacity mode for a table. The options are:
    --
    -- • @throughputMode:PAY_PER_REQUEST@
    --
    -- • @throughputMode:PROVISIONED@
    GetTableResponse -> Maybe CapacitySpecificationSummary
capacitySpecification :: Prelude.Maybe CapacitySpecificationSummary,
    -- | The the description of the specified table.
    GetTableResponse -> Maybe Comment
comment :: Prelude.Maybe Comment,
    -- | The creation timestamp of the specified table.
    GetTableResponse -> Maybe POSIX
creationTimestamp :: Prelude.Maybe Data.POSIX,
    -- | The default Time to Live settings of the specified table.
    GetTableResponse -> Maybe Natural
defaultTimeToLive :: Prelude.Maybe Prelude.Natural,
    -- | The encryption settings of the specified table.
    GetTableResponse -> Maybe EncryptionSpecification
encryptionSpecification :: Prelude.Maybe EncryptionSpecification,
    -- | The point-in-time recovery status of the specified table.
    GetTableResponse -> Maybe PointInTimeRecoverySummary
pointInTimeRecovery :: Prelude.Maybe PointInTimeRecoverySummary,
    -- | The schema definition of the specified table.
    GetTableResponse -> Maybe SchemaDefinition
schemaDefinition :: Prelude.Maybe SchemaDefinition,
    -- | The current status of the specified table.
    GetTableResponse -> Maybe TableStatus
status :: Prelude.Maybe TableStatus,
    -- | The custom Time to Live settings of the specified table.
    GetTableResponse -> Maybe TimeToLive
ttl :: Prelude.Maybe TimeToLive,
    -- | The response's http status code.
    GetTableResponse -> Int
httpStatus :: Prelude.Int,
    -- | The name of the keyspace that the specified table is stored in.
    GetTableResponse -> Text
keyspaceName :: Prelude.Text,
    -- | The name of the specified table.
    GetTableResponse -> Text
tableName :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the specified table.
    GetTableResponse -> Text
resourceArn :: Prelude.Text
  }
  deriving (GetTableResponse -> GetTableResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetTableResponse -> GetTableResponse -> Bool
$c/= :: GetTableResponse -> GetTableResponse -> Bool
== :: GetTableResponse -> GetTableResponse -> Bool
$c== :: GetTableResponse -> GetTableResponse -> Bool
Prelude.Eq, ReadPrec [GetTableResponse]
ReadPrec GetTableResponse
Int -> ReadS GetTableResponse
ReadS [GetTableResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetTableResponse]
$creadListPrec :: ReadPrec [GetTableResponse]
readPrec :: ReadPrec GetTableResponse
$creadPrec :: ReadPrec GetTableResponse
readList :: ReadS [GetTableResponse]
$creadList :: ReadS [GetTableResponse]
readsPrec :: Int -> ReadS GetTableResponse
$creadsPrec :: Int -> ReadS GetTableResponse
Prelude.Read, Int -> GetTableResponse -> ShowS
[GetTableResponse] -> ShowS
GetTableResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetTableResponse] -> ShowS
$cshowList :: [GetTableResponse] -> ShowS
show :: GetTableResponse -> String
$cshow :: GetTableResponse -> String
showsPrec :: Int -> GetTableResponse -> ShowS
$cshowsPrec :: Int -> GetTableResponse -> ShowS
Prelude.Show, forall x. Rep GetTableResponse x -> GetTableResponse
forall x. GetTableResponse -> Rep GetTableResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetTableResponse x -> GetTableResponse
$cfrom :: forall x. GetTableResponse -> Rep GetTableResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetTableResponse' 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:
--
-- 'capacitySpecification', 'getTableResponse_capacitySpecification' - The read\/write throughput capacity mode for a table. The options are:
--
-- • @throughputMode:PAY_PER_REQUEST@
--
-- • @throughputMode:PROVISIONED@
--
-- 'comment', 'getTableResponse_comment' - The the description of the specified table.
--
-- 'creationTimestamp', 'getTableResponse_creationTimestamp' - The creation timestamp of the specified table.
--
-- 'defaultTimeToLive', 'getTableResponse_defaultTimeToLive' - The default Time to Live settings of the specified table.
--
-- 'encryptionSpecification', 'getTableResponse_encryptionSpecification' - The encryption settings of the specified table.
--
-- 'pointInTimeRecovery', 'getTableResponse_pointInTimeRecovery' - The point-in-time recovery status of the specified table.
--
-- 'schemaDefinition', 'getTableResponse_schemaDefinition' - The schema definition of the specified table.
--
-- 'status', 'getTableResponse_status' - The current status of the specified table.
--
-- 'ttl', 'getTableResponse_ttl' - The custom Time to Live settings of the specified table.
--
-- 'httpStatus', 'getTableResponse_httpStatus' - The response's http status code.
--
-- 'keyspaceName', 'getTableResponse_keyspaceName' - The name of the keyspace that the specified table is stored in.
--
-- 'tableName', 'getTableResponse_tableName' - The name of the specified table.
--
-- 'resourceArn', 'getTableResponse_resourceArn' - The Amazon Resource Name (ARN) of the specified table.
newGetTableResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'keyspaceName'
  Prelude.Text ->
  -- | 'tableName'
  Prelude.Text ->
  -- | 'resourceArn'
  Prelude.Text ->
  GetTableResponse
newGetTableResponse :: Int -> Text -> Text -> Text -> GetTableResponse
newGetTableResponse
  Int
pHttpStatus_
  Text
pKeyspaceName_
  Text
pTableName_
  Text
pResourceArn_ =
    GetTableResponse'
      { $sel:capacitySpecification:GetTableResponse' :: Maybe CapacitySpecificationSummary
capacitySpecification =
          forall a. Maybe a
Prelude.Nothing,
        $sel:comment:GetTableResponse' :: Maybe Comment
comment = forall a. Maybe a
Prelude.Nothing,
        $sel:creationTimestamp:GetTableResponse' :: Maybe POSIX
creationTimestamp = forall a. Maybe a
Prelude.Nothing,
        $sel:defaultTimeToLive:GetTableResponse' :: Maybe Natural
defaultTimeToLive = forall a. Maybe a
Prelude.Nothing,
        $sel:encryptionSpecification:GetTableResponse' :: Maybe EncryptionSpecification
encryptionSpecification = forall a. Maybe a
Prelude.Nothing,
        $sel:pointInTimeRecovery:GetTableResponse' :: Maybe PointInTimeRecoverySummary
pointInTimeRecovery = forall a. Maybe a
Prelude.Nothing,
        $sel:schemaDefinition:GetTableResponse' :: Maybe SchemaDefinition
schemaDefinition = forall a. Maybe a
Prelude.Nothing,
        $sel:status:GetTableResponse' :: Maybe TableStatus
status = forall a. Maybe a
Prelude.Nothing,
        $sel:ttl:GetTableResponse' :: Maybe TimeToLive
ttl = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetTableResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:keyspaceName:GetTableResponse' :: Text
keyspaceName = Text
pKeyspaceName_,
        $sel:tableName:GetTableResponse' :: Text
tableName = Text
pTableName_,
        $sel:resourceArn:GetTableResponse' :: Text
resourceArn = Text
pResourceArn_
      }

-- | The read\/write throughput capacity mode for a table. The options are:
--
-- • @throughputMode:PAY_PER_REQUEST@
--
-- • @throughputMode:PROVISIONED@
getTableResponse_capacitySpecification :: Lens.Lens' GetTableResponse (Prelude.Maybe CapacitySpecificationSummary)
getTableResponse_capacitySpecification :: Lens' GetTableResponse (Maybe CapacitySpecificationSummary)
getTableResponse_capacitySpecification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTableResponse' {Maybe CapacitySpecificationSummary
capacitySpecification :: Maybe CapacitySpecificationSummary
$sel:capacitySpecification:GetTableResponse' :: GetTableResponse -> Maybe CapacitySpecificationSummary
capacitySpecification} -> Maybe CapacitySpecificationSummary
capacitySpecification) (\s :: GetTableResponse
s@GetTableResponse' {} Maybe CapacitySpecificationSummary
a -> GetTableResponse
s {$sel:capacitySpecification:GetTableResponse' :: Maybe CapacitySpecificationSummary
capacitySpecification = Maybe CapacitySpecificationSummary
a} :: GetTableResponse)

-- | The the description of the specified table.
getTableResponse_comment :: Lens.Lens' GetTableResponse (Prelude.Maybe Comment)
getTableResponse_comment :: Lens' GetTableResponse (Maybe Comment)
getTableResponse_comment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTableResponse' {Maybe Comment
comment :: Maybe Comment
$sel:comment:GetTableResponse' :: GetTableResponse -> Maybe Comment
comment} -> Maybe Comment
comment) (\s :: GetTableResponse
s@GetTableResponse' {} Maybe Comment
a -> GetTableResponse
s {$sel:comment:GetTableResponse' :: Maybe Comment
comment = Maybe Comment
a} :: GetTableResponse)

-- | The creation timestamp of the specified table.
getTableResponse_creationTimestamp :: Lens.Lens' GetTableResponse (Prelude.Maybe Prelude.UTCTime)
getTableResponse_creationTimestamp :: Lens' GetTableResponse (Maybe UTCTime)
getTableResponse_creationTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTableResponse' {Maybe POSIX
creationTimestamp :: Maybe POSIX
$sel:creationTimestamp:GetTableResponse' :: GetTableResponse -> Maybe POSIX
creationTimestamp} -> Maybe POSIX
creationTimestamp) (\s :: GetTableResponse
s@GetTableResponse' {} Maybe POSIX
a -> GetTableResponse
s {$sel:creationTimestamp:GetTableResponse' :: Maybe POSIX
creationTimestamp = Maybe POSIX
a} :: GetTableResponse) 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 default Time to Live settings of the specified table.
getTableResponse_defaultTimeToLive :: Lens.Lens' GetTableResponse (Prelude.Maybe Prelude.Natural)
getTableResponse_defaultTimeToLive :: Lens' GetTableResponse (Maybe Natural)
getTableResponse_defaultTimeToLive = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTableResponse' {Maybe Natural
defaultTimeToLive :: Maybe Natural
$sel:defaultTimeToLive:GetTableResponse' :: GetTableResponse -> Maybe Natural
defaultTimeToLive} -> Maybe Natural
defaultTimeToLive) (\s :: GetTableResponse
s@GetTableResponse' {} Maybe Natural
a -> GetTableResponse
s {$sel:defaultTimeToLive:GetTableResponse' :: Maybe Natural
defaultTimeToLive = Maybe Natural
a} :: GetTableResponse)

-- | The encryption settings of the specified table.
getTableResponse_encryptionSpecification :: Lens.Lens' GetTableResponse (Prelude.Maybe EncryptionSpecification)
getTableResponse_encryptionSpecification :: Lens' GetTableResponse (Maybe EncryptionSpecification)
getTableResponse_encryptionSpecification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTableResponse' {Maybe EncryptionSpecification
encryptionSpecification :: Maybe EncryptionSpecification
$sel:encryptionSpecification:GetTableResponse' :: GetTableResponse -> Maybe EncryptionSpecification
encryptionSpecification} -> Maybe EncryptionSpecification
encryptionSpecification) (\s :: GetTableResponse
s@GetTableResponse' {} Maybe EncryptionSpecification
a -> GetTableResponse
s {$sel:encryptionSpecification:GetTableResponse' :: Maybe EncryptionSpecification
encryptionSpecification = Maybe EncryptionSpecification
a} :: GetTableResponse)

-- | The point-in-time recovery status of the specified table.
getTableResponse_pointInTimeRecovery :: Lens.Lens' GetTableResponse (Prelude.Maybe PointInTimeRecoverySummary)
getTableResponse_pointInTimeRecovery :: Lens' GetTableResponse (Maybe PointInTimeRecoverySummary)
getTableResponse_pointInTimeRecovery = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTableResponse' {Maybe PointInTimeRecoverySummary
pointInTimeRecovery :: Maybe PointInTimeRecoverySummary
$sel:pointInTimeRecovery:GetTableResponse' :: GetTableResponse -> Maybe PointInTimeRecoverySummary
pointInTimeRecovery} -> Maybe PointInTimeRecoverySummary
pointInTimeRecovery) (\s :: GetTableResponse
s@GetTableResponse' {} Maybe PointInTimeRecoverySummary
a -> GetTableResponse
s {$sel:pointInTimeRecovery:GetTableResponse' :: Maybe PointInTimeRecoverySummary
pointInTimeRecovery = Maybe PointInTimeRecoverySummary
a} :: GetTableResponse)

-- | The schema definition of the specified table.
getTableResponse_schemaDefinition :: Lens.Lens' GetTableResponse (Prelude.Maybe SchemaDefinition)
getTableResponse_schemaDefinition :: Lens' GetTableResponse (Maybe SchemaDefinition)
getTableResponse_schemaDefinition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTableResponse' {Maybe SchemaDefinition
schemaDefinition :: Maybe SchemaDefinition
$sel:schemaDefinition:GetTableResponse' :: GetTableResponse -> Maybe SchemaDefinition
schemaDefinition} -> Maybe SchemaDefinition
schemaDefinition) (\s :: GetTableResponse
s@GetTableResponse' {} Maybe SchemaDefinition
a -> GetTableResponse
s {$sel:schemaDefinition:GetTableResponse' :: Maybe SchemaDefinition
schemaDefinition = Maybe SchemaDefinition
a} :: GetTableResponse)

-- | The current status of the specified table.
getTableResponse_status :: Lens.Lens' GetTableResponse (Prelude.Maybe TableStatus)
getTableResponse_status :: Lens' GetTableResponse (Maybe TableStatus)
getTableResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTableResponse' {Maybe TableStatus
status :: Maybe TableStatus
$sel:status:GetTableResponse' :: GetTableResponse -> Maybe TableStatus
status} -> Maybe TableStatus
status) (\s :: GetTableResponse
s@GetTableResponse' {} Maybe TableStatus
a -> GetTableResponse
s {$sel:status:GetTableResponse' :: Maybe TableStatus
status = Maybe TableStatus
a} :: GetTableResponse)

-- | The custom Time to Live settings of the specified table.
getTableResponse_ttl :: Lens.Lens' GetTableResponse (Prelude.Maybe TimeToLive)
getTableResponse_ttl :: Lens' GetTableResponse (Maybe TimeToLive)
getTableResponse_ttl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTableResponse' {Maybe TimeToLive
ttl :: Maybe TimeToLive
$sel:ttl:GetTableResponse' :: GetTableResponse -> Maybe TimeToLive
ttl} -> Maybe TimeToLive
ttl) (\s :: GetTableResponse
s@GetTableResponse' {} Maybe TimeToLive
a -> GetTableResponse
s {$sel:ttl:GetTableResponse' :: Maybe TimeToLive
ttl = Maybe TimeToLive
a} :: GetTableResponse)

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

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

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

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

instance Prelude.NFData GetTableResponse where
  rnf :: GetTableResponse -> ()
rnf GetTableResponse' {Int
Maybe Natural
Maybe POSIX
Maybe Comment
Maybe EncryptionSpecification
Maybe PointInTimeRecoverySummary
Maybe SchemaDefinition
Maybe TableStatus
Maybe CapacitySpecificationSummary
Maybe TimeToLive
Text
resourceArn :: Text
tableName :: Text
keyspaceName :: Text
httpStatus :: Int
ttl :: Maybe TimeToLive
status :: Maybe TableStatus
schemaDefinition :: Maybe SchemaDefinition
pointInTimeRecovery :: Maybe PointInTimeRecoverySummary
encryptionSpecification :: Maybe EncryptionSpecification
defaultTimeToLive :: Maybe Natural
creationTimestamp :: Maybe POSIX
comment :: Maybe Comment
capacitySpecification :: Maybe CapacitySpecificationSummary
$sel:resourceArn:GetTableResponse' :: GetTableResponse -> Text
$sel:tableName:GetTableResponse' :: GetTableResponse -> Text
$sel:keyspaceName:GetTableResponse' :: GetTableResponse -> Text
$sel:httpStatus:GetTableResponse' :: GetTableResponse -> Int
$sel:ttl:GetTableResponse' :: GetTableResponse -> Maybe TimeToLive
$sel:status:GetTableResponse' :: GetTableResponse -> Maybe TableStatus
$sel:schemaDefinition:GetTableResponse' :: GetTableResponse -> Maybe SchemaDefinition
$sel:pointInTimeRecovery:GetTableResponse' :: GetTableResponse -> Maybe PointInTimeRecoverySummary
$sel:encryptionSpecification:GetTableResponse' :: GetTableResponse -> Maybe EncryptionSpecification
$sel:defaultTimeToLive:GetTableResponse' :: GetTableResponse -> Maybe Natural
$sel:creationTimestamp:GetTableResponse' :: GetTableResponse -> Maybe POSIX
$sel:comment:GetTableResponse' :: GetTableResponse -> Maybe Comment
$sel:capacitySpecification:GetTableResponse' :: GetTableResponse -> Maybe CapacitySpecificationSummary
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CapacitySpecificationSummary
capacitySpecification
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Comment
comment
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationTimestamp
      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 PointInTimeRecoverySummary
pointInTimeRecovery
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SchemaDefinition
schemaDefinition
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TableStatus
status
      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 Int
httpStatus
      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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceArn