{-# 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.SDB.DomainMetadata
-- 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 domain, including when the domain was
-- created, the number of items and attributes in the domain, and the size
-- of the attribute names and values.
module Amazonka.SDB.DomainMetadata
  ( -- * Creating a Request
    DomainMetadata (..),
    newDomainMetadata,

    -- * Request Lenses
    domainMetadata_domainName,

    -- * Destructuring the Response
    DomainMetadataResponse (..),
    newDomainMetadataResponse,

    -- * Response Lenses
    domainMetadataResponse_attributeNameCount,
    domainMetadataResponse_attributeNamesSizeBytes,
    domainMetadataResponse_attributeValueCount,
    domainMetadataResponse_attributeValuesSizeBytes,
    domainMetadataResponse_itemCount,
    domainMetadataResponse_itemNamesSizeBytes,
    domainMetadataResponse_timestamp,
    domainMetadataResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDomainMetadata' smart constructor.
data DomainMetadata = DomainMetadata'
  { -- | The name of the domain for which to display the metadata of.
    DomainMetadata -> Text
domainName :: Prelude.Text
  }
  deriving (DomainMetadata -> DomainMetadata -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DomainMetadata -> DomainMetadata -> Bool
$c/= :: DomainMetadata -> DomainMetadata -> Bool
== :: DomainMetadata -> DomainMetadata -> Bool
$c== :: DomainMetadata -> DomainMetadata -> Bool
Prelude.Eq, ReadPrec [DomainMetadata]
ReadPrec DomainMetadata
Int -> ReadS DomainMetadata
ReadS [DomainMetadata]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DomainMetadata]
$creadListPrec :: ReadPrec [DomainMetadata]
readPrec :: ReadPrec DomainMetadata
$creadPrec :: ReadPrec DomainMetadata
readList :: ReadS [DomainMetadata]
$creadList :: ReadS [DomainMetadata]
readsPrec :: Int -> ReadS DomainMetadata
$creadsPrec :: Int -> ReadS DomainMetadata
Prelude.Read, Int -> DomainMetadata -> ShowS
[DomainMetadata] -> ShowS
DomainMetadata -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DomainMetadata] -> ShowS
$cshowList :: [DomainMetadata] -> ShowS
show :: DomainMetadata -> String
$cshow :: DomainMetadata -> String
showsPrec :: Int -> DomainMetadata -> ShowS
$cshowsPrec :: Int -> DomainMetadata -> ShowS
Prelude.Show, forall x. Rep DomainMetadata x -> DomainMetadata
forall x. DomainMetadata -> Rep DomainMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DomainMetadata x -> DomainMetadata
$cfrom :: forall x. DomainMetadata -> Rep DomainMetadata x
Prelude.Generic)

-- |
-- Create a value of 'DomainMetadata' 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:
--
-- 'domainName', 'domainMetadata_domainName' - The name of the domain for which to display the metadata of.
newDomainMetadata ::
  -- | 'domainName'
  Prelude.Text ->
  DomainMetadata
newDomainMetadata :: Text -> DomainMetadata
newDomainMetadata Text
pDomainName_ =
  DomainMetadata' {$sel:domainName:DomainMetadata' :: Text
domainName = Text
pDomainName_}

-- | The name of the domain for which to display the metadata of.
domainMetadata_domainName :: Lens.Lens' DomainMetadata Prelude.Text
domainMetadata_domainName :: Lens' DomainMetadata Text
domainMetadata_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DomainMetadata' {Text
domainName :: Text
$sel:domainName:DomainMetadata' :: DomainMetadata -> Text
domainName} -> Text
domainName) (\s :: DomainMetadata
s@DomainMetadata' {} Text
a -> DomainMetadata
s {$sel:domainName:DomainMetadata' :: Text
domainName = Text
a} :: DomainMetadata)

instance Core.AWSRequest DomainMetadata where
  type
    AWSResponse DomainMetadata =
      DomainMetadataResponse
  request :: (Service -> Service) -> DomainMetadata -> Request DomainMetadata
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DomainMetadata
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DomainMetadata)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"DomainMetadataResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Int
-> Maybe Integer
-> Maybe Int
-> Maybe Integer
-> Maybe Int
-> Maybe Integer
-> Maybe Int
-> Int
-> DomainMetadataResponse
DomainMetadataResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"AttributeNameCount")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"AttributeNamesSizeBytes")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"AttributeValueCount")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"AttributeValuesSizeBytes")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"ItemCount")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"ItemNamesSizeBytes")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Timestamp")
            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 DomainMetadata where
  hashWithSalt :: Int -> DomainMetadata -> Int
hashWithSalt Int
_salt DomainMetadata' {Text
domainName :: Text
$sel:domainName:DomainMetadata' :: DomainMetadata -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName

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

instance Data.ToHeaders DomainMetadata where
  toHeaders :: DomainMetadata -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery DomainMetadata where
  toQuery :: DomainMetadata -> QueryString
toQuery DomainMetadata' {Text
domainName :: Text
$sel:domainName:DomainMetadata' :: DomainMetadata -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DomainMetadata" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2009-04-15" :: Prelude.ByteString),
        ByteString
"DomainName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
domainName
      ]

-- | /See:/ 'newDomainMetadataResponse' smart constructor.
data DomainMetadataResponse = DomainMetadataResponse'
  { -- | The number of unique attribute names in the domain.
    DomainMetadataResponse -> Maybe Int
attributeNameCount :: Prelude.Maybe Prelude.Int,
    -- | The total size of all unique attribute names in the domain, in bytes.
    DomainMetadataResponse -> Maybe Integer
attributeNamesSizeBytes :: Prelude.Maybe Prelude.Integer,
    -- | The number of all attribute name\/value pairs in the domain.
    DomainMetadataResponse -> Maybe Int
attributeValueCount :: Prelude.Maybe Prelude.Int,
    -- | The total size of all attribute values in the domain, in bytes.
    DomainMetadataResponse -> Maybe Integer
attributeValuesSizeBytes :: Prelude.Maybe Prelude.Integer,
    -- | The number of all items in the domain.
    DomainMetadataResponse -> Maybe Int
itemCount :: Prelude.Maybe Prelude.Int,
    -- | The total size of all item names in the domain, in bytes.
    DomainMetadataResponse -> Maybe Integer
itemNamesSizeBytes :: Prelude.Maybe Prelude.Integer,
    -- | The data and time when metadata was calculated, in Epoch (UNIX) seconds.
    DomainMetadataResponse -> Maybe Int
timestamp :: Prelude.Maybe Prelude.Int,
    -- | The response's http status code.
    DomainMetadataResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DomainMetadataResponse -> DomainMetadataResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DomainMetadataResponse -> DomainMetadataResponse -> Bool
$c/= :: DomainMetadataResponse -> DomainMetadataResponse -> Bool
== :: DomainMetadataResponse -> DomainMetadataResponse -> Bool
$c== :: DomainMetadataResponse -> DomainMetadataResponse -> Bool
Prelude.Eq, ReadPrec [DomainMetadataResponse]
ReadPrec DomainMetadataResponse
Int -> ReadS DomainMetadataResponse
ReadS [DomainMetadataResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DomainMetadataResponse]
$creadListPrec :: ReadPrec [DomainMetadataResponse]
readPrec :: ReadPrec DomainMetadataResponse
$creadPrec :: ReadPrec DomainMetadataResponse
readList :: ReadS [DomainMetadataResponse]
$creadList :: ReadS [DomainMetadataResponse]
readsPrec :: Int -> ReadS DomainMetadataResponse
$creadsPrec :: Int -> ReadS DomainMetadataResponse
Prelude.Read, Int -> DomainMetadataResponse -> ShowS
[DomainMetadataResponse] -> ShowS
DomainMetadataResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DomainMetadataResponse] -> ShowS
$cshowList :: [DomainMetadataResponse] -> ShowS
show :: DomainMetadataResponse -> String
$cshow :: DomainMetadataResponse -> String
showsPrec :: Int -> DomainMetadataResponse -> ShowS
$cshowsPrec :: Int -> DomainMetadataResponse -> ShowS
Prelude.Show, forall x. Rep DomainMetadataResponse x -> DomainMetadataResponse
forall x. DomainMetadataResponse -> Rep DomainMetadataResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DomainMetadataResponse x -> DomainMetadataResponse
$cfrom :: forall x. DomainMetadataResponse -> Rep DomainMetadataResponse x
Prelude.Generic)

-- |
-- Create a value of 'DomainMetadataResponse' 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:
--
-- 'attributeNameCount', 'domainMetadataResponse_attributeNameCount' - The number of unique attribute names in the domain.
--
-- 'attributeNamesSizeBytes', 'domainMetadataResponse_attributeNamesSizeBytes' - The total size of all unique attribute names in the domain, in bytes.
--
-- 'attributeValueCount', 'domainMetadataResponse_attributeValueCount' - The number of all attribute name\/value pairs in the domain.
--
-- 'attributeValuesSizeBytes', 'domainMetadataResponse_attributeValuesSizeBytes' - The total size of all attribute values in the domain, in bytes.
--
-- 'itemCount', 'domainMetadataResponse_itemCount' - The number of all items in the domain.
--
-- 'itemNamesSizeBytes', 'domainMetadataResponse_itemNamesSizeBytes' - The total size of all item names in the domain, in bytes.
--
-- 'timestamp', 'domainMetadataResponse_timestamp' - The data and time when metadata was calculated, in Epoch (UNIX) seconds.
--
-- 'httpStatus', 'domainMetadataResponse_httpStatus' - The response's http status code.
newDomainMetadataResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DomainMetadataResponse
newDomainMetadataResponse :: Int -> DomainMetadataResponse
newDomainMetadataResponse Int
pHttpStatus_ =
  DomainMetadataResponse'
    { $sel:attributeNameCount:DomainMetadataResponse' :: Maybe Int
attributeNameCount =
        forall a. Maybe a
Prelude.Nothing,
      $sel:attributeNamesSizeBytes:DomainMetadataResponse' :: Maybe Integer
attributeNamesSizeBytes = forall a. Maybe a
Prelude.Nothing,
      $sel:attributeValueCount:DomainMetadataResponse' :: Maybe Int
attributeValueCount = forall a. Maybe a
Prelude.Nothing,
      $sel:attributeValuesSizeBytes:DomainMetadataResponse' :: Maybe Integer
attributeValuesSizeBytes = forall a. Maybe a
Prelude.Nothing,
      $sel:itemCount:DomainMetadataResponse' :: Maybe Int
itemCount = forall a. Maybe a
Prelude.Nothing,
      $sel:itemNamesSizeBytes:DomainMetadataResponse' :: Maybe Integer
itemNamesSizeBytes = forall a. Maybe a
Prelude.Nothing,
      $sel:timestamp:DomainMetadataResponse' :: Maybe Int
timestamp = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DomainMetadataResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The number of unique attribute names in the domain.
domainMetadataResponse_attributeNameCount :: Lens.Lens' DomainMetadataResponse (Prelude.Maybe Prelude.Int)
domainMetadataResponse_attributeNameCount :: Lens' DomainMetadataResponse (Maybe Int)
domainMetadataResponse_attributeNameCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DomainMetadataResponse' {Maybe Int
attributeNameCount :: Maybe Int
$sel:attributeNameCount:DomainMetadataResponse' :: DomainMetadataResponse -> Maybe Int
attributeNameCount} -> Maybe Int
attributeNameCount) (\s :: DomainMetadataResponse
s@DomainMetadataResponse' {} Maybe Int
a -> DomainMetadataResponse
s {$sel:attributeNameCount:DomainMetadataResponse' :: Maybe Int
attributeNameCount = Maybe Int
a} :: DomainMetadataResponse)

-- | The total size of all unique attribute names in the domain, in bytes.
domainMetadataResponse_attributeNamesSizeBytes :: Lens.Lens' DomainMetadataResponse (Prelude.Maybe Prelude.Integer)
domainMetadataResponse_attributeNamesSizeBytes :: Lens' DomainMetadataResponse (Maybe Integer)
domainMetadataResponse_attributeNamesSizeBytes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DomainMetadataResponse' {Maybe Integer
attributeNamesSizeBytes :: Maybe Integer
$sel:attributeNamesSizeBytes:DomainMetadataResponse' :: DomainMetadataResponse -> Maybe Integer
attributeNamesSizeBytes} -> Maybe Integer
attributeNamesSizeBytes) (\s :: DomainMetadataResponse
s@DomainMetadataResponse' {} Maybe Integer
a -> DomainMetadataResponse
s {$sel:attributeNamesSizeBytes:DomainMetadataResponse' :: Maybe Integer
attributeNamesSizeBytes = Maybe Integer
a} :: DomainMetadataResponse)

-- | The number of all attribute name\/value pairs in the domain.
domainMetadataResponse_attributeValueCount :: Lens.Lens' DomainMetadataResponse (Prelude.Maybe Prelude.Int)
domainMetadataResponse_attributeValueCount :: Lens' DomainMetadataResponse (Maybe Int)
domainMetadataResponse_attributeValueCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DomainMetadataResponse' {Maybe Int
attributeValueCount :: Maybe Int
$sel:attributeValueCount:DomainMetadataResponse' :: DomainMetadataResponse -> Maybe Int
attributeValueCount} -> Maybe Int
attributeValueCount) (\s :: DomainMetadataResponse
s@DomainMetadataResponse' {} Maybe Int
a -> DomainMetadataResponse
s {$sel:attributeValueCount:DomainMetadataResponse' :: Maybe Int
attributeValueCount = Maybe Int
a} :: DomainMetadataResponse)

-- | The total size of all attribute values in the domain, in bytes.
domainMetadataResponse_attributeValuesSizeBytes :: Lens.Lens' DomainMetadataResponse (Prelude.Maybe Prelude.Integer)
domainMetadataResponse_attributeValuesSizeBytes :: Lens' DomainMetadataResponse (Maybe Integer)
domainMetadataResponse_attributeValuesSizeBytes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DomainMetadataResponse' {Maybe Integer
attributeValuesSizeBytes :: Maybe Integer
$sel:attributeValuesSizeBytes:DomainMetadataResponse' :: DomainMetadataResponse -> Maybe Integer
attributeValuesSizeBytes} -> Maybe Integer
attributeValuesSizeBytes) (\s :: DomainMetadataResponse
s@DomainMetadataResponse' {} Maybe Integer
a -> DomainMetadataResponse
s {$sel:attributeValuesSizeBytes:DomainMetadataResponse' :: Maybe Integer
attributeValuesSizeBytes = Maybe Integer
a} :: DomainMetadataResponse)

-- | The number of all items in the domain.
domainMetadataResponse_itemCount :: Lens.Lens' DomainMetadataResponse (Prelude.Maybe Prelude.Int)
domainMetadataResponse_itemCount :: Lens' DomainMetadataResponse (Maybe Int)
domainMetadataResponse_itemCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DomainMetadataResponse' {Maybe Int
itemCount :: Maybe Int
$sel:itemCount:DomainMetadataResponse' :: DomainMetadataResponse -> Maybe Int
itemCount} -> Maybe Int
itemCount) (\s :: DomainMetadataResponse
s@DomainMetadataResponse' {} Maybe Int
a -> DomainMetadataResponse
s {$sel:itemCount:DomainMetadataResponse' :: Maybe Int
itemCount = Maybe Int
a} :: DomainMetadataResponse)

-- | The total size of all item names in the domain, in bytes.
domainMetadataResponse_itemNamesSizeBytes :: Lens.Lens' DomainMetadataResponse (Prelude.Maybe Prelude.Integer)
domainMetadataResponse_itemNamesSizeBytes :: Lens' DomainMetadataResponse (Maybe Integer)
domainMetadataResponse_itemNamesSizeBytes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DomainMetadataResponse' {Maybe Integer
itemNamesSizeBytes :: Maybe Integer
$sel:itemNamesSizeBytes:DomainMetadataResponse' :: DomainMetadataResponse -> Maybe Integer
itemNamesSizeBytes} -> Maybe Integer
itemNamesSizeBytes) (\s :: DomainMetadataResponse
s@DomainMetadataResponse' {} Maybe Integer
a -> DomainMetadataResponse
s {$sel:itemNamesSizeBytes:DomainMetadataResponse' :: Maybe Integer
itemNamesSizeBytes = Maybe Integer
a} :: DomainMetadataResponse)

-- | The data and time when metadata was calculated, in Epoch (UNIX) seconds.
domainMetadataResponse_timestamp :: Lens.Lens' DomainMetadataResponse (Prelude.Maybe Prelude.Int)
domainMetadataResponse_timestamp :: Lens' DomainMetadataResponse (Maybe Int)
domainMetadataResponse_timestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DomainMetadataResponse' {Maybe Int
timestamp :: Maybe Int
$sel:timestamp:DomainMetadataResponse' :: DomainMetadataResponse -> Maybe Int
timestamp} -> Maybe Int
timestamp) (\s :: DomainMetadataResponse
s@DomainMetadataResponse' {} Maybe Int
a -> DomainMetadataResponse
s {$sel:timestamp:DomainMetadataResponse' :: Maybe Int
timestamp = Maybe Int
a} :: DomainMetadataResponse)

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

instance Prelude.NFData DomainMetadataResponse where
  rnf :: DomainMetadataResponse -> ()
rnf DomainMetadataResponse' {Int
Maybe Int
Maybe Integer
httpStatus :: Int
timestamp :: Maybe Int
itemNamesSizeBytes :: Maybe Integer
itemCount :: Maybe Int
attributeValuesSizeBytes :: Maybe Integer
attributeValueCount :: Maybe Int
attributeNamesSizeBytes :: Maybe Integer
attributeNameCount :: Maybe Int
$sel:httpStatus:DomainMetadataResponse' :: DomainMetadataResponse -> Int
$sel:timestamp:DomainMetadataResponse' :: DomainMetadataResponse -> Maybe Int
$sel:itemNamesSizeBytes:DomainMetadataResponse' :: DomainMetadataResponse -> Maybe Integer
$sel:itemCount:DomainMetadataResponse' :: DomainMetadataResponse -> Maybe Int
$sel:attributeValuesSizeBytes:DomainMetadataResponse' :: DomainMetadataResponse -> Maybe Integer
$sel:attributeValueCount:DomainMetadataResponse' :: DomainMetadataResponse -> Maybe Int
$sel:attributeNamesSizeBytes:DomainMetadataResponse' :: DomainMetadataResponse -> Maybe Integer
$sel:attributeNameCount:DomainMetadataResponse' :: DomainMetadataResponse -> Maybe Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
attributeNameCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
attributeNamesSizeBytes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
attributeValueCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
attributeValuesSizeBytes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
itemCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
itemNamesSizeBytes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
timestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus