{-# 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.CloudDirectory.ListObjectAttributes
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists all attributes that are associated with an object.
--
-- This operation returns paginated results.
module Amazonka.CloudDirectory.ListObjectAttributes
  ( -- * Creating a Request
    ListObjectAttributes (..),
    newListObjectAttributes,

    -- * Request Lenses
    listObjectAttributes_consistencyLevel,
    listObjectAttributes_facetFilter,
    listObjectAttributes_maxResults,
    listObjectAttributes_nextToken,
    listObjectAttributes_directoryArn,
    listObjectAttributes_objectReference,

    -- * Destructuring the Response
    ListObjectAttributesResponse (..),
    newListObjectAttributesResponse,

    -- * Response Lenses
    listObjectAttributesResponse_attributes,
    listObjectAttributesResponse_nextToken,
    listObjectAttributesResponse_httpStatus,
  )
where

import Amazonka.CloudDirectory.Types
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

-- | /See:/ 'newListObjectAttributes' smart constructor.
data ListObjectAttributes = ListObjectAttributes'
  { -- | Represents the manner and timing in which the successful write or update
    -- of an object is reflected in a subsequent read operation of that same
    -- object.
    ListObjectAttributes -> Maybe ConsistencyLevel
consistencyLevel :: Prelude.Maybe ConsistencyLevel,
    -- | Used to filter the list of object attributes that are associated with a
    -- certain facet.
    ListObjectAttributes -> Maybe SchemaFacet
facetFilter :: Prelude.Maybe SchemaFacet,
    -- | The maximum number of items to be retrieved in a single call. This is an
    -- approximate number.
    ListObjectAttributes -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The pagination token.
    ListObjectAttributes -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) that is associated with the Directory
    -- where the object resides. For more information, see arns.
    ListObjectAttributes -> Text
directoryArn :: Prelude.Text,
    -- | The reference that identifies the object whose attributes will be
    -- listed.
    ListObjectAttributes -> ObjectReference
objectReference :: ObjectReference
  }
  deriving (ListObjectAttributes -> ListObjectAttributes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListObjectAttributes -> ListObjectAttributes -> Bool
$c/= :: ListObjectAttributes -> ListObjectAttributes -> Bool
== :: ListObjectAttributes -> ListObjectAttributes -> Bool
$c== :: ListObjectAttributes -> ListObjectAttributes -> Bool
Prelude.Eq, ReadPrec [ListObjectAttributes]
ReadPrec ListObjectAttributes
Int -> ReadS ListObjectAttributes
ReadS [ListObjectAttributes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListObjectAttributes]
$creadListPrec :: ReadPrec [ListObjectAttributes]
readPrec :: ReadPrec ListObjectAttributes
$creadPrec :: ReadPrec ListObjectAttributes
readList :: ReadS [ListObjectAttributes]
$creadList :: ReadS [ListObjectAttributes]
readsPrec :: Int -> ReadS ListObjectAttributes
$creadsPrec :: Int -> ReadS ListObjectAttributes
Prelude.Read, Int -> ListObjectAttributes -> ShowS
[ListObjectAttributes] -> ShowS
ListObjectAttributes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListObjectAttributes] -> ShowS
$cshowList :: [ListObjectAttributes] -> ShowS
show :: ListObjectAttributes -> String
$cshow :: ListObjectAttributes -> String
showsPrec :: Int -> ListObjectAttributes -> ShowS
$cshowsPrec :: Int -> ListObjectAttributes -> ShowS
Prelude.Show, forall x. Rep ListObjectAttributes x -> ListObjectAttributes
forall x. ListObjectAttributes -> Rep ListObjectAttributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListObjectAttributes x -> ListObjectAttributes
$cfrom :: forall x. ListObjectAttributes -> Rep ListObjectAttributes x
Prelude.Generic)

-- |
-- Create a value of 'ListObjectAttributes' 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:
--
-- 'consistencyLevel', 'listObjectAttributes_consistencyLevel' - Represents the manner and timing in which the successful write or update
-- of an object is reflected in a subsequent read operation of that same
-- object.
--
-- 'facetFilter', 'listObjectAttributes_facetFilter' - Used to filter the list of object attributes that are associated with a
-- certain facet.
--
-- 'maxResults', 'listObjectAttributes_maxResults' - The maximum number of items to be retrieved in a single call. This is an
-- approximate number.
--
-- 'nextToken', 'listObjectAttributes_nextToken' - The pagination token.
--
-- 'directoryArn', 'listObjectAttributes_directoryArn' - The Amazon Resource Name (ARN) that is associated with the Directory
-- where the object resides. For more information, see arns.
--
-- 'objectReference', 'listObjectAttributes_objectReference' - The reference that identifies the object whose attributes will be
-- listed.
newListObjectAttributes ::
  -- | 'directoryArn'
  Prelude.Text ->
  -- | 'objectReference'
  ObjectReference ->
  ListObjectAttributes
newListObjectAttributes :: Text -> ObjectReference -> ListObjectAttributes
newListObjectAttributes
  Text
pDirectoryArn_
  ObjectReference
pObjectReference_ =
    ListObjectAttributes'
      { $sel:consistencyLevel:ListObjectAttributes' :: Maybe ConsistencyLevel
consistencyLevel =
          forall a. Maybe a
Prelude.Nothing,
        $sel:facetFilter:ListObjectAttributes' :: Maybe SchemaFacet
facetFilter = forall a. Maybe a
Prelude.Nothing,
        $sel:maxResults:ListObjectAttributes' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
        $sel:nextToken:ListObjectAttributes' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
        $sel:directoryArn:ListObjectAttributes' :: Text
directoryArn = Text
pDirectoryArn_,
        $sel:objectReference:ListObjectAttributes' :: ObjectReference
objectReference = ObjectReference
pObjectReference_
      }

-- | Represents the manner and timing in which the successful write or update
-- of an object is reflected in a subsequent read operation of that same
-- object.
listObjectAttributes_consistencyLevel :: Lens.Lens' ListObjectAttributes (Prelude.Maybe ConsistencyLevel)
listObjectAttributes_consistencyLevel :: Lens' ListObjectAttributes (Maybe ConsistencyLevel)
listObjectAttributes_consistencyLevel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListObjectAttributes' {Maybe ConsistencyLevel
consistencyLevel :: Maybe ConsistencyLevel
$sel:consistencyLevel:ListObjectAttributes' :: ListObjectAttributes -> Maybe ConsistencyLevel
consistencyLevel} -> Maybe ConsistencyLevel
consistencyLevel) (\s :: ListObjectAttributes
s@ListObjectAttributes' {} Maybe ConsistencyLevel
a -> ListObjectAttributes
s {$sel:consistencyLevel:ListObjectAttributes' :: Maybe ConsistencyLevel
consistencyLevel = Maybe ConsistencyLevel
a} :: ListObjectAttributes)

-- | Used to filter the list of object attributes that are associated with a
-- certain facet.
listObjectAttributes_facetFilter :: Lens.Lens' ListObjectAttributes (Prelude.Maybe SchemaFacet)
listObjectAttributes_facetFilter :: Lens' ListObjectAttributes (Maybe SchemaFacet)
listObjectAttributes_facetFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListObjectAttributes' {Maybe SchemaFacet
facetFilter :: Maybe SchemaFacet
$sel:facetFilter:ListObjectAttributes' :: ListObjectAttributes -> Maybe SchemaFacet
facetFilter} -> Maybe SchemaFacet
facetFilter) (\s :: ListObjectAttributes
s@ListObjectAttributes' {} Maybe SchemaFacet
a -> ListObjectAttributes
s {$sel:facetFilter:ListObjectAttributes' :: Maybe SchemaFacet
facetFilter = Maybe SchemaFacet
a} :: ListObjectAttributes)

-- | The maximum number of items to be retrieved in a single call. This is an
-- approximate number.
listObjectAttributes_maxResults :: Lens.Lens' ListObjectAttributes (Prelude.Maybe Prelude.Natural)
listObjectAttributes_maxResults :: Lens' ListObjectAttributes (Maybe Natural)
listObjectAttributes_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListObjectAttributes' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListObjectAttributes' :: ListObjectAttributes -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListObjectAttributes
s@ListObjectAttributes' {} Maybe Natural
a -> ListObjectAttributes
s {$sel:maxResults:ListObjectAttributes' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListObjectAttributes)

-- | The pagination token.
listObjectAttributes_nextToken :: Lens.Lens' ListObjectAttributes (Prelude.Maybe Prelude.Text)
listObjectAttributes_nextToken :: Lens' ListObjectAttributes (Maybe Text)
listObjectAttributes_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListObjectAttributes' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListObjectAttributes' :: ListObjectAttributes -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListObjectAttributes
s@ListObjectAttributes' {} Maybe Text
a -> ListObjectAttributes
s {$sel:nextToken:ListObjectAttributes' :: Maybe Text
nextToken = Maybe Text
a} :: ListObjectAttributes)

-- | The Amazon Resource Name (ARN) that is associated with the Directory
-- where the object resides. For more information, see arns.
listObjectAttributes_directoryArn :: Lens.Lens' ListObjectAttributes Prelude.Text
listObjectAttributes_directoryArn :: Lens' ListObjectAttributes Text
listObjectAttributes_directoryArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListObjectAttributes' {Text
directoryArn :: Text
$sel:directoryArn:ListObjectAttributes' :: ListObjectAttributes -> Text
directoryArn} -> Text
directoryArn) (\s :: ListObjectAttributes
s@ListObjectAttributes' {} Text
a -> ListObjectAttributes
s {$sel:directoryArn:ListObjectAttributes' :: Text
directoryArn = Text
a} :: ListObjectAttributes)

-- | The reference that identifies the object whose attributes will be
-- listed.
listObjectAttributes_objectReference :: Lens.Lens' ListObjectAttributes ObjectReference
listObjectAttributes_objectReference :: Lens' ListObjectAttributes ObjectReference
listObjectAttributes_objectReference = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListObjectAttributes' {ObjectReference
objectReference :: ObjectReference
$sel:objectReference:ListObjectAttributes' :: ListObjectAttributes -> ObjectReference
objectReference} -> ObjectReference
objectReference) (\s :: ListObjectAttributes
s@ListObjectAttributes' {} ObjectReference
a -> ListObjectAttributes
s {$sel:objectReference:ListObjectAttributes' :: ObjectReference
objectReference = ObjectReference
a} :: ListObjectAttributes)

instance Core.AWSPager ListObjectAttributes where
  page :: ListObjectAttributes
-> AWSResponse ListObjectAttributes -> Maybe ListObjectAttributes
page ListObjectAttributes
rq AWSResponse ListObjectAttributes
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListObjectAttributes
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListObjectAttributesResponse (Maybe Text)
listObjectAttributesResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListObjectAttributes
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListObjectAttributesResponse (Maybe [AttributeKeyAndValue])
listObjectAttributesResponse_attributes
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListObjectAttributes
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListObjectAttributes (Maybe Text)
listObjectAttributes_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListObjectAttributes
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListObjectAttributesResponse (Maybe Text)
listObjectAttributesResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest ListObjectAttributes where
  type
    AWSResponse ListObjectAttributes =
      ListObjectAttributesResponse
  request :: (Service -> Service)
-> ListObjectAttributes -> Request ListObjectAttributes
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 ListObjectAttributes
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListObjectAttributes)))
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 [AttributeKeyAndValue]
-> Maybe Text -> Int -> ListObjectAttributesResponse
ListObjectAttributesResponse'
            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
"Attributes" 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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"NextToken")
            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 ListObjectAttributes where
  hashWithSalt :: Int -> ListObjectAttributes -> Int
hashWithSalt Int
_salt ListObjectAttributes' {Maybe Natural
Maybe Text
Maybe ConsistencyLevel
Maybe SchemaFacet
Text
ObjectReference
objectReference :: ObjectReference
directoryArn :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
facetFilter :: Maybe SchemaFacet
consistencyLevel :: Maybe ConsistencyLevel
$sel:objectReference:ListObjectAttributes' :: ListObjectAttributes -> ObjectReference
$sel:directoryArn:ListObjectAttributes' :: ListObjectAttributes -> Text
$sel:nextToken:ListObjectAttributes' :: ListObjectAttributes -> Maybe Text
$sel:maxResults:ListObjectAttributes' :: ListObjectAttributes -> Maybe Natural
$sel:facetFilter:ListObjectAttributes' :: ListObjectAttributes -> Maybe SchemaFacet
$sel:consistencyLevel:ListObjectAttributes' :: ListObjectAttributes -> Maybe ConsistencyLevel
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ConsistencyLevel
consistencyLevel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SchemaFacet
facetFilter
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
directoryArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ObjectReference
objectReference

instance Prelude.NFData ListObjectAttributes where
  rnf :: ListObjectAttributes -> ()
rnf ListObjectAttributes' {Maybe Natural
Maybe Text
Maybe ConsistencyLevel
Maybe SchemaFacet
Text
ObjectReference
objectReference :: ObjectReference
directoryArn :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
facetFilter :: Maybe SchemaFacet
consistencyLevel :: Maybe ConsistencyLevel
$sel:objectReference:ListObjectAttributes' :: ListObjectAttributes -> ObjectReference
$sel:directoryArn:ListObjectAttributes' :: ListObjectAttributes -> Text
$sel:nextToken:ListObjectAttributes' :: ListObjectAttributes -> Maybe Text
$sel:maxResults:ListObjectAttributes' :: ListObjectAttributes -> Maybe Natural
$sel:facetFilter:ListObjectAttributes' :: ListObjectAttributes -> Maybe SchemaFacet
$sel:consistencyLevel:ListObjectAttributes' :: ListObjectAttributes -> Maybe ConsistencyLevel
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ConsistencyLevel
consistencyLevel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SchemaFacet
facetFilter
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
directoryArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ObjectReference
objectReference

instance Data.ToHeaders ListObjectAttributes where
  toHeaders :: ListObjectAttributes -> ResponseHeaders
toHeaders ListObjectAttributes' {Maybe Natural
Maybe Text
Maybe ConsistencyLevel
Maybe SchemaFacet
Text
ObjectReference
objectReference :: ObjectReference
directoryArn :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
facetFilter :: Maybe SchemaFacet
consistencyLevel :: Maybe ConsistencyLevel
$sel:objectReference:ListObjectAttributes' :: ListObjectAttributes -> ObjectReference
$sel:directoryArn:ListObjectAttributes' :: ListObjectAttributes -> Text
$sel:nextToken:ListObjectAttributes' :: ListObjectAttributes -> Maybe Text
$sel:maxResults:ListObjectAttributes' :: ListObjectAttributes -> Maybe Natural
$sel:facetFilter:ListObjectAttributes' :: ListObjectAttributes -> Maybe SchemaFacet
$sel:consistencyLevel:ListObjectAttributes' :: ListObjectAttributes -> Maybe ConsistencyLevel
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"x-amz-consistency-level" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe ConsistencyLevel
consistencyLevel,
        HeaderName
"x-amz-data-partition" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Text
directoryArn
      ]

instance Data.ToJSON ListObjectAttributes where
  toJSON :: ListObjectAttributes -> Value
toJSON ListObjectAttributes' {Maybe Natural
Maybe Text
Maybe ConsistencyLevel
Maybe SchemaFacet
Text
ObjectReference
objectReference :: ObjectReference
directoryArn :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
facetFilter :: Maybe SchemaFacet
consistencyLevel :: Maybe ConsistencyLevel
$sel:objectReference:ListObjectAttributes' :: ListObjectAttributes -> ObjectReference
$sel:directoryArn:ListObjectAttributes' :: ListObjectAttributes -> Text
$sel:nextToken:ListObjectAttributes' :: ListObjectAttributes -> Maybe Text
$sel:maxResults:ListObjectAttributes' :: ListObjectAttributes -> Maybe Natural
$sel:facetFilter:ListObjectAttributes' :: ListObjectAttributes -> Maybe SchemaFacet
$sel:consistencyLevel:ListObjectAttributes' :: ListObjectAttributes -> Maybe ConsistencyLevel
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"FacetFilter" 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 SchemaFacet
facetFilter,
            (Key
"MaxResults" 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
maxResults,
            (Key
"NextToken" 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 Text
nextToken,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ObjectReference" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ObjectReference
objectReference)
          ]
      )

instance Data.ToPath ListObjectAttributes where
  toPath :: ListObjectAttributes -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const
      ByteString
"/amazonclouddirectory/2017-01-11/object/attributes"

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

-- | /See:/ 'newListObjectAttributesResponse' smart constructor.
data ListObjectAttributesResponse = ListObjectAttributesResponse'
  { -- | Attributes map that is associated with the object. @AttributeArn@ is the
    -- key, and attribute value is the value.
    ListObjectAttributesResponse -> Maybe [AttributeKeyAndValue]
attributes :: Prelude.Maybe [AttributeKeyAndValue],
    -- | The pagination token.
    ListObjectAttributesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListObjectAttributesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListObjectAttributesResponse
-> ListObjectAttributesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListObjectAttributesResponse
-> ListObjectAttributesResponse -> Bool
$c/= :: ListObjectAttributesResponse
-> ListObjectAttributesResponse -> Bool
== :: ListObjectAttributesResponse
-> ListObjectAttributesResponse -> Bool
$c== :: ListObjectAttributesResponse
-> ListObjectAttributesResponse -> Bool
Prelude.Eq, ReadPrec [ListObjectAttributesResponse]
ReadPrec ListObjectAttributesResponse
Int -> ReadS ListObjectAttributesResponse
ReadS [ListObjectAttributesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListObjectAttributesResponse]
$creadListPrec :: ReadPrec [ListObjectAttributesResponse]
readPrec :: ReadPrec ListObjectAttributesResponse
$creadPrec :: ReadPrec ListObjectAttributesResponse
readList :: ReadS [ListObjectAttributesResponse]
$creadList :: ReadS [ListObjectAttributesResponse]
readsPrec :: Int -> ReadS ListObjectAttributesResponse
$creadsPrec :: Int -> ReadS ListObjectAttributesResponse
Prelude.Read, Int -> ListObjectAttributesResponse -> ShowS
[ListObjectAttributesResponse] -> ShowS
ListObjectAttributesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListObjectAttributesResponse] -> ShowS
$cshowList :: [ListObjectAttributesResponse] -> ShowS
show :: ListObjectAttributesResponse -> String
$cshow :: ListObjectAttributesResponse -> String
showsPrec :: Int -> ListObjectAttributesResponse -> ShowS
$cshowsPrec :: Int -> ListObjectAttributesResponse -> ShowS
Prelude.Show, forall x.
Rep ListObjectAttributesResponse x -> ListObjectAttributesResponse
forall x.
ListObjectAttributesResponse -> Rep ListObjectAttributesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListObjectAttributesResponse x -> ListObjectAttributesResponse
$cfrom :: forall x.
ListObjectAttributesResponse -> Rep ListObjectAttributesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListObjectAttributesResponse' 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:
--
-- 'attributes', 'listObjectAttributesResponse_attributes' - Attributes map that is associated with the object. @AttributeArn@ is the
-- key, and attribute value is the value.
--
-- 'nextToken', 'listObjectAttributesResponse_nextToken' - The pagination token.
--
-- 'httpStatus', 'listObjectAttributesResponse_httpStatus' - The response's http status code.
newListObjectAttributesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListObjectAttributesResponse
newListObjectAttributesResponse :: Int -> ListObjectAttributesResponse
newListObjectAttributesResponse Int
pHttpStatus_ =
  ListObjectAttributesResponse'
    { $sel:attributes:ListObjectAttributesResponse' :: Maybe [AttributeKeyAndValue]
attributes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListObjectAttributesResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListObjectAttributesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Attributes map that is associated with the object. @AttributeArn@ is the
-- key, and attribute value is the value.
listObjectAttributesResponse_attributes :: Lens.Lens' ListObjectAttributesResponse (Prelude.Maybe [AttributeKeyAndValue])
listObjectAttributesResponse_attributes :: Lens' ListObjectAttributesResponse (Maybe [AttributeKeyAndValue])
listObjectAttributesResponse_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListObjectAttributesResponse' {Maybe [AttributeKeyAndValue]
attributes :: Maybe [AttributeKeyAndValue]
$sel:attributes:ListObjectAttributesResponse' :: ListObjectAttributesResponse -> Maybe [AttributeKeyAndValue]
attributes} -> Maybe [AttributeKeyAndValue]
attributes) (\s :: ListObjectAttributesResponse
s@ListObjectAttributesResponse' {} Maybe [AttributeKeyAndValue]
a -> ListObjectAttributesResponse
s {$sel:attributes:ListObjectAttributesResponse' :: Maybe [AttributeKeyAndValue]
attributes = Maybe [AttributeKeyAndValue]
a} :: ListObjectAttributesResponse) 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 pagination token.
listObjectAttributesResponse_nextToken :: Lens.Lens' ListObjectAttributesResponse (Prelude.Maybe Prelude.Text)
listObjectAttributesResponse_nextToken :: Lens' ListObjectAttributesResponse (Maybe Text)
listObjectAttributesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListObjectAttributesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListObjectAttributesResponse' :: ListObjectAttributesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListObjectAttributesResponse
s@ListObjectAttributesResponse' {} Maybe Text
a -> ListObjectAttributesResponse
s {$sel:nextToken:ListObjectAttributesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListObjectAttributesResponse)

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

instance Prelude.NFData ListObjectAttributesResponse where
  rnf :: ListObjectAttributesResponse -> ()
rnf ListObjectAttributesResponse' {Int
Maybe [AttributeKeyAndValue]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
attributes :: Maybe [AttributeKeyAndValue]
$sel:httpStatus:ListObjectAttributesResponse' :: ListObjectAttributesResponse -> Int
$sel:nextToken:ListObjectAttributesResponse' :: ListObjectAttributesResponse -> Maybe Text
$sel:attributes:ListObjectAttributesResponse' :: ListObjectAttributesResponse -> Maybe [AttributeKeyAndValue]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [AttributeKeyAndValue]
attributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus