{-# 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.DescribeTimeToLive
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gives a description of the Time to Live (TTL) status on the specified
-- table.
module Amazonka.DynamoDB.DescribeTimeToLive
  ( -- * Creating a Request
    DescribeTimeToLive (..),
    newDescribeTimeToLive,

    -- * Request Lenses
    describeTimeToLive_tableName,

    -- * Destructuring the Response
    DescribeTimeToLiveResponse (..),
    newDescribeTimeToLiveResponse,

    -- * Response Lenses
    describeTimeToLiveResponse_timeToLiveDescription,
    describeTimeToLiveResponse_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:/ 'newDescribeTimeToLive' smart constructor.
data DescribeTimeToLive = DescribeTimeToLive'
  { -- | The name of the table to be described.
    DescribeTimeToLive -> Text
tableName :: Prelude.Text
  }
  deriving (DescribeTimeToLive -> DescribeTimeToLive -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeTimeToLive -> DescribeTimeToLive -> Bool
$c/= :: DescribeTimeToLive -> DescribeTimeToLive -> Bool
== :: DescribeTimeToLive -> DescribeTimeToLive -> Bool
$c== :: DescribeTimeToLive -> DescribeTimeToLive -> Bool
Prelude.Eq, ReadPrec [DescribeTimeToLive]
ReadPrec DescribeTimeToLive
Int -> ReadS DescribeTimeToLive
ReadS [DescribeTimeToLive]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeTimeToLive]
$creadListPrec :: ReadPrec [DescribeTimeToLive]
readPrec :: ReadPrec DescribeTimeToLive
$creadPrec :: ReadPrec DescribeTimeToLive
readList :: ReadS [DescribeTimeToLive]
$creadList :: ReadS [DescribeTimeToLive]
readsPrec :: Int -> ReadS DescribeTimeToLive
$creadsPrec :: Int -> ReadS DescribeTimeToLive
Prelude.Read, Int -> DescribeTimeToLive -> ShowS
[DescribeTimeToLive] -> ShowS
DescribeTimeToLive -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeTimeToLive] -> ShowS
$cshowList :: [DescribeTimeToLive] -> ShowS
show :: DescribeTimeToLive -> String
$cshow :: DescribeTimeToLive -> String
showsPrec :: Int -> DescribeTimeToLive -> ShowS
$cshowsPrec :: Int -> DescribeTimeToLive -> ShowS
Prelude.Show, forall x. Rep DescribeTimeToLive x -> DescribeTimeToLive
forall x. DescribeTimeToLive -> Rep DescribeTimeToLive x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeTimeToLive x -> DescribeTimeToLive
$cfrom :: forall x. DescribeTimeToLive -> Rep DescribeTimeToLive x
Prelude.Generic)

-- |
-- Create a value of 'DescribeTimeToLive' 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', 'describeTimeToLive_tableName' - The name of the table to be described.
newDescribeTimeToLive ::
  -- | 'tableName'
  Prelude.Text ->
  DescribeTimeToLive
newDescribeTimeToLive :: Text -> DescribeTimeToLive
newDescribeTimeToLive Text
pTableName_ =
  DescribeTimeToLive' {$sel:tableName:DescribeTimeToLive' :: Text
tableName = Text
pTableName_}

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

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

instance Prelude.NFData DescribeTimeToLive where
  rnf :: DescribeTimeToLive -> ()
rnf DescribeTimeToLive' {Text
tableName :: Text
$sel:tableName:DescribeTimeToLive' :: DescribeTimeToLive -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
tableName

instance Data.ToHeaders DescribeTimeToLive where
  toHeaders :: DescribeTimeToLive -> 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.DescribeTimeToLive" ::
                          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 DescribeTimeToLive where
  toJSON :: DescribeTimeToLive -> Value
toJSON DescribeTimeToLive' {Text
tableName :: Text
$sel:tableName:DescribeTimeToLive' :: DescribeTimeToLive -> 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)]
      )

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

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

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

-- |
-- Create a value of 'DescribeTimeToLiveResponse' 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:
--
-- 'timeToLiveDescription', 'describeTimeToLiveResponse_timeToLiveDescription' -
--
-- 'httpStatus', 'describeTimeToLiveResponse_httpStatus' - The response's http status code.
newDescribeTimeToLiveResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeTimeToLiveResponse
newDescribeTimeToLiveResponse :: Int -> DescribeTimeToLiveResponse
newDescribeTimeToLiveResponse Int
pHttpStatus_ =
  DescribeTimeToLiveResponse'
    { $sel:timeToLiveDescription:DescribeTimeToLiveResponse' :: Maybe TimeToLiveDescription
timeToLiveDescription =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeTimeToLiveResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

describeTimeToLiveResponse_timeToLiveDescription :: Lens.Lens' DescribeTimeToLiveResponse (Prelude.Maybe TimeToLiveDescription)
describeTimeToLiveResponse_timeToLiveDescription :: Lens' DescribeTimeToLiveResponse (Maybe TimeToLiveDescription)
describeTimeToLiveResponse_timeToLiveDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeTimeToLiveResponse' {Maybe TimeToLiveDescription
timeToLiveDescription :: Maybe TimeToLiveDescription
$sel:timeToLiveDescription:DescribeTimeToLiveResponse' :: DescribeTimeToLiveResponse -> Maybe TimeToLiveDescription
timeToLiveDescription} -> Maybe TimeToLiveDescription
timeToLiveDescription) (\s :: DescribeTimeToLiveResponse
s@DescribeTimeToLiveResponse' {} Maybe TimeToLiveDescription
a -> DescribeTimeToLiveResponse
s {$sel:timeToLiveDescription:DescribeTimeToLiveResponse' :: Maybe TimeToLiveDescription
timeToLiveDescription = Maybe TimeToLiveDescription
a} :: DescribeTimeToLiveResponse)

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

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