{-# 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.DescribeGlobalTableSettings
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes Region-specific settings for a global table.
--
-- This operation only applies to
-- <https://docs.aws.amazon.com/amazondynamodb/latest/developerguide/globaltables.V1.html Version 2017.11.29>
-- of global tables.
module Amazonka.DynamoDB.DescribeGlobalTableSettings
  ( -- * Creating a Request
    DescribeGlobalTableSettings (..),
    newDescribeGlobalTableSettings,

    -- * Request Lenses
    describeGlobalTableSettings_globalTableName,

    -- * Destructuring the Response
    DescribeGlobalTableSettingsResponse (..),
    newDescribeGlobalTableSettingsResponse,

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

-- |
-- Create a value of 'DescribeGlobalTableSettings' 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:
--
-- 'globalTableName', 'describeGlobalTableSettings_globalTableName' - The name of the global table to describe.
newDescribeGlobalTableSettings ::
  -- | 'globalTableName'
  Prelude.Text ->
  DescribeGlobalTableSettings
newDescribeGlobalTableSettings :: Text -> DescribeGlobalTableSettings
newDescribeGlobalTableSettings Text
pGlobalTableName_ =
  DescribeGlobalTableSettings'
    { $sel:globalTableName:DescribeGlobalTableSettings' :: Text
globalTableName =
        Text
pGlobalTableName_
    }

-- | The name of the global table to describe.
describeGlobalTableSettings_globalTableName :: Lens.Lens' DescribeGlobalTableSettings Prelude.Text
describeGlobalTableSettings_globalTableName :: Lens' DescribeGlobalTableSettings Text
describeGlobalTableSettings_globalTableName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeGlobalTableSettings' {Text
globalTableName :: Text
$sel:globalTableName:DescribeGlobalTableSettings' :: DescribeGlobalTableSettings -> Text
globalTableName} -> Text
globalTableName) (\s :: DescribeGlobalTableSettings
s@DescribeGlobalTableSettings' {} Text
a -> DescribeGlobalTableSettings
s {$sel:globalTableName:DescribeGlobalTableSettings' :: Text
globalTableName = Text
a} :: DescribeGlobalTableSettings)

instance Core.AWSRequest DescribeGlobalTableSettings where
  type
    AWSResponse DescribeGlobalTableSettings =
      DescribeGlobalTableSettingsResponse
  request :: (Service -> Service)
-> DescribeGlobalTableSettings
-> Request DescribeGlobalTableSettings
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 DescribeGlobalTableSettings
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeGlobalTableSettings)))
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 Text
-> Maybe [ReplicaSettingsDescription]
-> Int
-> DescribeGlobalTableSettingsResponse
DescribeGlobalTableSettingsResponse'
            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
"GlobalTableName")
            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
"ReplicaSettings"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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 DescribeGlobalTableSettings where
  hashWithSalt :: Int -> DescribeGlobalTableSettings -> Int
hashWithSalt Int
_salt DescribeGlobalTableSettings' {Text
globalTableName :: Text
$sel:globalTableName:DescribeGlobalTableSettings' :: DescribeGlobalTableSettings -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
globalTableName

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

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

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

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

-- | /See:/ 'newDescribeGlobalTableSettingsResponse' smart constructor.
data DescribeGlobalTableSettingsResponse = DescribeGlobalTableSettingsResponse'
  { -- | The name of the global table.
    DescribeGlobalTableSettingsResponse -> Maybe Text
globalTableName :: Prelude.Maybe Prelude.Text,
    -- | The Region-specific settings for the global table.
    DescribeGlobalTableSettingsResponse
-> Maybe [ReplicaSettingsDescription]
replicaSettings :: Prelude.Maybe [ReplicaSettingsDescription],
    -- | The response's http status code.
    DescribeGlobalTableSettingsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeGlobalTableSettingsResponse
-> DescribeGlobalTableSettingsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeGlobalTableSettingsResponse
-> DescribeGlobalTableSettingsResponse -> Bool
$c/= :: DescribeGlobalTableSettingsResponse
-> DescribeGlobalTableSettingsResponse -> Bool
== :: DescribeGlobalTableSettingsResponse
-> DescribeGlobalTableSettingsResponse -> Bool
$c== :: DescribeGlobalTableSettingsResponse
-> DescribeGlobalTableSettingsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeGlobalTableSettingsResponse]
ReadPrec DescribeGlobalTableSettingsResponse
Int -> ReadS DescribeGlobalTableSettingsResponse
ReadS [DescribeGlobalTableSettingsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeGlobalTableSettingsResponse]
$creadListPrec :: ReadPrec [DescribeGlobalTableSettingsResponse]
readPrec :: ReadPrec DescribeGlobalTableSettingsResponse
$creadPrec :: ReadPrec DescribeGlobalTableSettingsResponse
readList :: ReadS [DescribeGlobalTableSettingsResponse]
$creadList :: ReadS [DescribeGlobalTableSettingsResponse]
readsPrec :: Int -> ReadS DescribeGlobalTableSettingsResponse
$creadsPrec :: Int -> ReadS DescribeGlobalTableSettingsResponse
Prelude.Read, Int -> DescribeGlobalTableSettingsResponse -> ShowS
[DescribeGlobalTableSettingsResponse] -> ShowS
DescribeGlobalTableSettingsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeGlobalTableSettingsResponse] -> ShowS
$cshowList :: [DescribeGlobalTableSettingsResponse] -> ShowS
show :: DescribeGlobalTableSettingsResponse -> String
$cshow :: DescribeGlobalTableSettingsResponse -> String
showsPrec :: Int -> DescribeGlobalTableSettingsResponse -> ShowS
$cshowsPrec :: Int -> DescribeGlobalTableSettingsResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeGlobalTableSettingsResponse x
-> DescribeGlobalTableSettingsResponse
forall x.
DescribeGlobalTableSettingsResponse
-> Rep DescribeGlobalTableSettingsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeGlobalTableSettingsResponse x
-> DescribeGlobalTableSettingsResponse
$cfrom :: forall x.
DescribeGlobalTableSettingsResponse
-> Rep DescribeGlobalTableSettingsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeGlobalTableSettingsResponse' 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:
--
-- 'globalTableName', 'describeGlobalTableSettingsResponse_globalTableName' - The name of the global table.
--
-- 'replicaSettings', 'describeGlobalTableSettingsResponse_replicaSettings' - The Region-specific settings for the global table.
--
-- 'httpStatus', 'describeGlobalTableSettingsResponse_httpStatus' - The response's http status code.
newDescribeGlobalTableSettingsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeGlobalTableSettingsResponse
newDescribeGlobalTableSettingsResponse :: Int -> DescribeGlobalTableSettingsResponse
newDescribeGlobalTableSettingsResponse Int
pHttpStatus_ =
  DescribeGlobalTableSettingsResponse'
    { $sel:globalTableName:DescribeGlobalTableSettingsResponse' :: Maybe Text
globalTableName =
        forall a. Maybe a
Prelude.Nothing,
      $sel:replicaSettings:DescribeGlobalTableSettingsResponse' :: Maybe [ReplicaSettingsDescription]
replicaSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeGlobalTableSettingsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The name of the global table.
describeGlobalTableSettingsResponse_globalTableName :: Lens.Lens' DescribeGlobalTableSettingsResponse (Prelude.Maybe Prelude.Text)
describeGlobalTableSettingsResponse_globalTableName :: Lens' DescribeGlobalTableSettingsResponse (Maybe Text)
describeGlobalTableSettingsResponse_globalTableName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeGlobalTableSettingsResponse' {Maybe Text
globalTableName :: Maybe Text
$sel:globalTableName:DescribeGlobalTableSettingsResponse' :: DescribeGlobalTableSettingsResponse -> Maybe Text
globalTableName} -> Maybe Text
globalTableName) (\s :: DescribeGlobalTableSettingsResponse
s@DescribeGlobalTableSettingsResponse' {} Maybe Text
a -> DescribeGlobalTableSettingsResponse
s {$sel:globalTableName:DescribeGlobalTableSettingsResponse' :: Maybe Text
globalTableName = Maybe Text
a} :: DescribeGlobalTableSettingsResponse)

-- | The Region-specific settings for the global table.
describeGlobalTableSettingsResponse_replicaSettings :: Lens.Lens' DescribeGlobalTableSettingsResponse (Prelude.Maybe [ReplicaSettingsDescription])
describeGlobalTableSettingsResponse_replicaSettings :: Lens'
  DescribeGlobalTableSettingsResponse
  (Maybe [ReplicaSettingsDescription])
describeGlobalTableSettingsResponse_replicaSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeGlobalTableSettingsResponse' {Maybe [ReplicaSettingsDescription]
replicaSettings :: Maybe [ReplicaSettingsDescription]
$sel:replicaSettings:DescribeGlobalTableSettingsResponse' :: DescribeGlobalTableSettingsResponse
-> Maybe [ReplicaSettingsDescription]
replicaSettings} -> Maybe [ReplicaSettingsDescription]
replicaSettings) (\s :: DescribeGlobalTableSettingsResponse
s@DescribeGlobalTableSettingsResponse' {} Maybe [ReplicaSettingsDescription]
a -> DescribeGlobalTableSettingsResponse
s {$sel:replicaSettings:DescribeGlobalTableSettingsResponse' :: Maybe [ReplicaSettingsDescription]
replicaSettings = Maybe [ReplicaSettingsDescription]
a} :: DescribeGlobalTableSettingsResponse) 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

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

instance
  Prelude.NFData
    DescribeGlobalTableSettingsResponse
  where
  rnf :: DescribeGlobalTableSettingsResponse -> ()
rnf DescribeGlobalTableSettingsResponse' {Int
Maybe [ReplicaSettingsDescription]
Maybe Text
httpStatus :: Int
replicaSettings :: Maybe [ReplicaSettingsDescription]
globalTableName :: Maybe Text
$sel:httpStatus:DescribeGlobalTableSettingsResponse' :: DescribeGlobalTableSettingsResponse -> Int
$sel:replicaSettings:DescribeGlobalTableSettingsResponse' :: DescribeGlobalTableSettingsResponse
-> Maybe [ReplicaSettingsDescription]
$sel:globalTableName:DescribeGlobalTableSettingsResponse' :: DescribeGlobalTableSettingsResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
globalTableName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ReplicaSettingsDescription]
replicaSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus