{-# 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.ListIndex
-- 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 objects attached to the specified index.
--
-- This operation returns paginated results.
module Amazonka.CloudDirectory.ListIndex
  ( -- * Creating a Request
    ListIndex (..),
    newListIndex,

    -- * Request Lenses
    listIndex_consistencyLevel,
    listIndex_maxResults,
    listIndex_nextToken,
    listIndex_rangesOnIndexedValues,
    listIndex_directoryArn,
    listIndex_indexReference,

    -- * Destructuring the Response
    ListIndexResponse (..),
    newListIndexResponse,

    -- * Response Lenses
    listIndexResponse_indexAttachments,
    listIndexResponse_nextToken,
    listIndexResponse_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:/ 'newListIndex' smart constructor.
data ListIndex = ListIndex'
  { -- | The consistency level to execute the request at.
    ListIndex -> Maybe ConsistencyLevel
consistencyLevel :: Prelude.Maybe ConsistencyLevel,
    -- | The maximum number of objects in a single page to retrieve from the
    -- index during a request. For more information, see
    -- <http://docs.aws.amazon.com/clouddirectory/latest/developerguide/limits.html Amazon Cloud Directory Limits>.
    ListIndex -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The pagination token.
    ListIndex -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Specifies the ranges of indexed values that you want to query.
    ListIndex -> Maybe [ObjectAttributeRange]
rangesOnIndexedValues :: Prelude.Maybe [ObjectAttributeRange],
    -- | The ARN of the directory that the index exists in.
    ListIndex -> Text
directoryArn :: Prelude.Text,
    -- | The reference to the index to list.
    ListIndex -> ObjectReference
indexReference :: ObjectReference
  }
  deriving (ListIndex -> ListIndex -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListIndex -> ListIndex -> Bool
$c/= :: ListIndex -> ListIndex -> Bool
== :: ListIndex -> ListIndex -> Bool
$c== :: ListIndex -> ListIndex -> Bool
Prelude.Eq, ReadPrec [ListIndex]
ReadPrec ListIndex
Int -> ReadS ListIndex
ReadS [ListIndex]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListIndex]
$creadListPrec :: ReadPrec [ListIndex]
readPrec :: ReadPrec ListIndex
$creadPrec :: ReadPrec ListIndex
readList :: ReadS [ListIndex]
$creadList :: ReadS [ListIndex]
readsPrec :: Int -> ReadS ListIndex
$creadsPrec :: Int -> ReadS ListIndex
Prelude.Read, Int -> ListIndex -> ShowS
[ListIndex] -> ShowS
ListIndex -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListIndex] -> ShowS
$cshowList :: [ListIndex] -> ShowS
show :: ListIndex -> String
$cshow :: ListIndex -> String
showsPrec :: Int -> ListIndex -> ShowS
$cshowsPrec :: Int -> ListIndex -> ShowS
Prelude.Show, forall x. Rep ListIndex x -> ListIndex
forall x. ListIndex -> Rep ListIndex x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListIndex x -> ListIndex
$cfrom :: forall x. ListIndex -> Rep ListIndex x
Prelude.Generic)

-- |
-- Create a value of 'ListIndex' 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', 'listIndex_consistencyLevel' - The consistency level to execute the request at.
--
-- 'maxResults', 'listIndex_maxResults' - The maximum number of objects in a single page to retrieve from the
-- index during a request. For more information, see
-- <http://docs.aws.amazon.com/clouddirectory/latest/developerguide/limits.html Amazon Cloud Directory Limits>.
--
-- 'nextToken', 'listIndex_nextToken' - The pagination token.
--
-- 'rangesOnIndexedValues', 'listIndex_rangesOnIndexedValues' - Specifies the ranges of indexed values that you want to query.
--
-- 'directoryArn', 'listIndex_directoryArn' - The ARN of the directory that the index exists in.
--
-- 'indexReference', 'listIndex_indexReference' - The reference to the index to list.
newListIndex ::
  -- | 'directoryArn'
  Prelude.Text ->
  -- | 'indexReference'
  ObjectReference ->
  ListIndex
newListIndex :: Text -> ObjectReference -> ListIndex
newListIndex Text
pDirectoryArn_ ObjectReference
pIndexReference_ =
  ListIndex'
    { $sel:consistencyLevel:ListIndex' :: Maybe ConsistencyLevel
consistencyLevel = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListIndex' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListIndex' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:rangesOnIndexedValues:ListIndex' :: Maybe [ObjectAttributeRange]
rangesOnIndexedValues = forall a. Maybe a
Prelude.Nothing,
      $sel:directoryArn:ListIndex' :: Text
directoryArn = Text
pDirectoryArn_,
      $sel:indexReference:ListIndex' :: ObjectReference
indexReference = ObjectReference
pIndexReference_
    }

-- | The consistency level to execute the request at.
listIndex_consistencyLevel :: Lens.Lens' ListIndex (Prelude.Maybe ConsistencyLevel)
listIndex_consistencyLevel :: Lens' ListIndex (Maybe ConsistencyLevel)
listIndex_consistencyLevel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListIndex' {Maybe ConsistencyLevel
consistencyLevel :: Maybe ConsistencyLevel
$sel:consistencyLevel:ListIndex' :: ListIndex -> Maybe ConsistencyLevel
consistencyLevel} -> Maybe ConsistencyLevel
consistencyLevel) (\s :: ListIndex
s@ListIndex' {} Maybe ConsistencyLevel
a -> ListIndex
s {$sel:consistencyLevel:ListIndex' :: Maybe ConsistencyLevel
consistencyLevel = Maybe ConsistencyLevel
a} :: ListIndex)

-- | The maximum number of objects in a single page to retrieve from the
-- index during a request. For more information, see
-- <http://docs.aws.amazon.com/clouddirectory/latest/developerguide/limits.html Amazon Cloud Directory Limits>.
listIndex_maxResults :: Lens.Lens' ListIndex (Prelude.Maybe Prelude.Natural)
listIndex_maxResults :: Lens' ListIndex (Maybe Natural)
listIndex_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListIndex' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListIndex' :: ListIndex -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListIndex
s@ListIndex' {} Maybe Natural
a -> ListIndex
s {$sel:maxResults:ListIndex' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListIndex)

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

-- | Specifies the ranges of indexed values that you want to query.
listIndex_rangesOnIndexedValues :: Lens.Lens' ListIndex (Prelude.Maybe [ObjectAttributeRange])
listIndex_rangesOnIndexedValues :: Lens' ListIndex (Maybe [ObjectAttributeRange])
listIndex_rangesOnIndexedValues = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListIndex' {Maybe [ObjectAttributeRange]
rangesOnIndexedValues :: Maybe [ObjectAttributeRange]
$sel:rangesOnIndexedValues:ListIndex' :: ListIndex -> Maybe [ObjectAttributeRange]
rangesOnIndexedValues} -> Maybe [ObjectAttributeRange]
rangesOnIndexedValues) (\s :: ListIndex
s@ListIndex' {} Maybe [ObjectAttributeRange]
a -> ListIndex
s {$sel:rangesOnIndexedValues:ListIndex' :: Maybe [ObjectAttributeRange]
rangesOnIndexedValues = Maybe [ObjectAttributeRange]
a} :: ListIndex) 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 ARN of the directory that the index exists in.
listIndex_directoryArn :: Lens.Lens' ListIndex Prelude.Text
listIndex_directoryArn :: Lens' ListIndex Text
listIndex_directoryArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListIndex' {Text
directoryArn :: Text
$sel:directoryArn:ListIndex' :: ListIndex -> Text
directoryArn} -> Text
directoryArn) (\s :: ListIndex
s@ListIndex' {} Text
a -> ListIndex
s {$sel:directoryArn:ListIndex' :: Text
directoryArn = Text
a} :: ListIndex)

-- | The reference to the index to list.
listIndex_indexReference :: Lens.Lens' ListIndex ObjectReference
listIndex_indexReference :: Lens' ListIndex ObjectReference
listIndex_indexReference = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListIndex' {ObjectReference
indexReference :: ObjectReference
$sel:indexReference:ListIndex' :: ListIndex -> ObjectReference
indexReference} -> ObjectReference
indexReference) (\s :: ListIndex
s@ListIndex' {} ObjectReference
a -> ListIndex
s {$sel:indexReference:ListIndex' :: ObjectReference
indexReference = ObjectReference
a} :: ListIndex)

instance Core.AWSPager ListIndex where
  page :: ListIndex -> AWSResponse ListIndex -> Maybe ListIndex
page ListIndex
rq AWSResponse ListIndex
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListIndex
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListIndexResponse (Maybe Text)
listIndexResponse_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 ListIndex
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListIndexResponse (Maybe [IndexAttachment])
listIndexResponse_indexAttachments
            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.$ ListIndex
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListIndex (Maybe Text)
listIndex_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListIndex
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListIndexResponse (Maybe Text)
listIndexResponse_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 ListIndex where
  type AWSResponse ListIndex = ListIndexResponse
  request :: (Service -> Service) -> ListIndex -> Request ListIndex
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 ListIndex
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListIndex)))
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 [IndexAttachment] -> Maybe Text -> Int -> ListIndexResponse
ListIndexResponse'
            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
"IndexAttachments"
                            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 ListIndex where
  hashWithSalt :: Int -> ListIndex -> Int
hashWithSalt Int
_salt ListIndex' {Maybe Natural
Maybe [ObjectAttributeRange]
Maybe Text
Maybe ConsistencyLevel
Text
ObjectReference
indexReference :: ObjectReference
directoryArn :: Text
rangesOnIndexedValues :: Maybe [ObjectAttributeRange]
nextToken :: Maybe Text
maxResults :: Maybe Natural
consistencyLevel :: Maybe ConsistencyLevel
$sel:indexReference:ListIndex' :: ListIndex -> ObjectReference
$sel:directoryArn:ListIndex' :: ListIndex -> Text
$sel:rangesOnIndexedValues:ListIndex' :: ListIndex -> Maybe [ObjectAttributeRange]
$sel:nextToken:ListIndex' :: ListIndex -> Maybe Text
$sel:maxResults:ListIndex' :: ListIndex -> Maybe Natural
$sel:consistencyLevel:ListIndex' :: ListIndex -> 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 Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ObjectAttributeRange]
rangesOnIndexedValues
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
directoryArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ObjectReference
indexReference

instance Prelude.NFData ListIndex where
  rnf :: ListIndex -> ()
rnf ListIndex' {Maybe Natural
Maybe [ObjectAttributeRange]
Maybe Text
Maybe ConsistencyLevel
Text
ObjectReference
indexReference :: ObjectReference
directoryArn :: Text
rangesOnIndexedValues :: Maybe [ObjectAttributeRange]
nextToken :: Maybe Text
maxResults :: Maybe Natural
consistencyLevel :: Maybe ConsistencyLevel
$sel:indexReference:ListIndex' :: ListIndex -> ObjectReference
$sel:directoryArn:ListIndex' :: ListIndex -> Text
$sel:rangesOnIndexedValues:ListIndex' :: ListIndex -> Maybe [ObjectAttributeRange]
$sel:nextToken:ListIndex' :: ListIndex -> Maybe Text
$sel:maxResults:ListIndex' :: ListIndex -> Maybe Natural
$sel:consistencyLevel:ListIndex' :: ListIndex -> 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 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 Maybe [ObjectAttributeRange]
rangesOnIndexedValues
      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
indexReference

instance Data.ToHeaders ListIndex where
  toHeaders :: ListIndex -> ResponseHeaders
toHeaders ListIndex' {Maybe Natural
Maybe [ObjectAttributeRange]
Maybe Text
Maybe ConsistencyLevel
Text
ObjectReference
indexReference :: ObjectReference
directoryArn :: Text
rangesOnIndexedValues :: Maybe [ObjectAttributeRange]
nextToken :: Maybe Text
maxResults :: Maybe Natural
consistencyLevel :: Maybe ConsistencyLevel
$sel:indexReference:ListIndex' :: ListIndex -> ObjectReference
$sel:directoryArn:ListIndex' :: ListIndex -> Text
$sel:rangesOnIndexedValues:ListIndex' :: ListIndex -> Maybe [ObjectAttributeRange]
$sel:nextToken:ListIndex' :: ListIndex -> Maybe Text
$sel:maxResults:ListIndex' :: ListIndex -> Maybe Natural
$sel:consistencyLevel:ListIndex' :: ListIndex -> 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 ListIndex where
  toJSON :: ListIndex -> Value
toJSON ListIndex' {Maybe Natural
Maybe [ObjectAttributeRange]
Maybe Text
Maybe ConsistencyLevel
Text
ObjectReference
indexReference :: ObjectReference
directoryArn :: Text
rangesOnIndexedValues :: Maybe [ObjectAttributeRange]
nextToken :: Maybe Text
maxResults :: Maybe Natural
consistencyLevel :: Maybe ConsistencyLevel
$sel:indexReference:ListIndex' :: ListIndex -> ObjectReference
$sel:directoryArn:ListIndex' :: ListIndex -> Text
$sel:rangesOnIndexedValues:ListIndex' :: ListIndex -> Maybe [ObjectAttributeRange]
$sel:nextToken:ListIndex' :: ListIndex -> Maybe Text
$sel:maxResults:ListIndex' :: ListIndex -> Maybe Natural
$sel:consistencyLevel:ListIndex' :: ListIndex -> Maybe ConsistencyLevel
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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,
            (Key
"RangesOnIndexedValues" 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 [ObjectAttributeRange]
rangesOnIndexedValues,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"IndexReference" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ObjectReference
indexReference)
          ]
      )

instance Data.ToPath ListIndex where
  toPath :: ListIndex -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const
      ByteString
"/amazonclouddirectory/2017-01-11/index/targets"

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

-- | /See:/ 'newListIndexResponse' smart constructor.
data ListIndexResponse = ListIndexResponse'
  { -- | The objects and indexed values attached to the index.
    ListIndexResponse -> Maybe [IndexAttachment]
indexAttachments :: Prelude.Maybe [IndexAttachment],
    -- | The pagination token.
    ListIndexResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListIndexResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListIndexResponse -> ListIndexResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListIndexResponse -> ListIndexResponse -> Bool
$c/= :: ListIndexResponse -> ListIndexResponse -> Bool
== :: ListIndexResponse -> ListIndexResponse -> Bool
$c== :: ListIndexResponse -> ListIndexResponse -> Bool
Prelude.Eq, ReadPrec [ListIndexResponse]
ReadPrec ListIndexResponse
Int -> ReadS ListIndexResponse
ReadS [ListIndexResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListIndexResponse]
$creadListPrec :: ReadPrec [ListIndexResponse]
readPrec :: ReadPrec ListIndexResponse
$creadPrec :: ReadPrec ListIndexResponse
readList :: ReadS [ListIndexResponse]
$creadList :: ReadS [ListIndexResponse]
readsPrec :: Int -> ReadS ListIndexResponse
$creadsPrec :: Int -> ReadS ListIndexResponse
Prelude.Read, Int -> ListIndexResponse -> ShowS
[ListIndexResponse] -> ShowS
ListIndexResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListIndexResponse] -> ShowS
$cshowList :: [ListIndexResponse] -> ShowS
show :: ListIndexResponse -> String
$cshow :: ListIndexResponse -> String
showsPrec :: Int -> ListIndexResponse -> ShowS
$cshowsPrec :: Int -> ListIndexResponse -> ShowS
Prelude.Show, forall x. Rep ListIndexResponse x -> ListIndexResponse
forall x. ListIndexResponse -> Rep ListIndexResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListIndexResponse x -> ListIndexResponse
$cfrom :: forall x. ListIndexResponse -> Rep ListIndexResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListIndexResponse' 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:
--
-- 'indexAttachments', 'listIndexResponse_indexAttachments' - The objects and indexed values attached to the index.
--
-- 'nextToken', 'listIndexResponse_nextToken' - The pagination token.
--
-- 'httpStatus', 'listIndexResponse_httpStatus' - The response's http status code.
newListIndexResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListIndexResponse
newListIndexResponse :: Int -> ListIndexResponse
newListIndexResponse Int
pHttpStatus_ =
  ListIndexResponse'
    { $sel:indexAttachments:ListIndexResponse' :: Maybe [IndexAttachment]
indexAttachments =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListIndexResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListIndexResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The objects and indexed values attached to the index.
listIndexResponse_indexAttachments :: Lens.Lens' ListIndexResponse (Prelude.Maybe [IndexAttachment])
listIndexResponse_indexAttachments :: Lens' ListIndexResponse (Maybe [IndexAttachment])
listIndexResponse_indexAttachments = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListIndexResponse' {Maybe [IndexAttachment]
indexAttachments :: Maybe [IndexAttachment]
$sel:indexAttachments:ListIndexResponse' :: ListIndexResponse -> Maybe [IndexAttachment]
indexAttachments} -> Maybe [IndexAttachment]
indexAttachments) (\s :: ListIndexResponse
s@ListIndexResponse' {} Maybe [IndexAttachment]
a -> ListIndexResponse
s {$sel:indexAttachments:ListIndexResponse' :: Maybe [IndexAttachment]
indexAttachments = Maybe [IndexAttachment]
a} :: ListIndexResponse) 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.
listIndexResponse_nextToken :: Lens.Lens' ListIndexResponse (Prelude.Maybe Prelude.Text)
listIndexResponse_nextToken :: Lens' ListIndexResponse (Maybe Text)
listIndexResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListIndexResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListIndexResponse' :: ListIndexResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListIndexResponse
s@ListIndexResponse' {} Maybe Text
a -> ListIndexResponse
s {$sel:nextToken:ListIndexResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListIndexResponse)

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

instance Prelude.NFData ListIndexResponse where
  rnf :: ListIndexResponse -> ()
rnf ListIndexResponse' {Int
Maybe [IndexAttachment]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
indexAttachments :: Maybe [IndexAttachment]
$sel:httpStatus:ListIndexResponse' :: ListIndexResponse -> Int
$sel:nextToken:ListIndexResponse' :: ListIndexResponse -> Maybe Text
$sel:indexAttachments:ListIndexResponse' :: ListIndexResponse -> Maybe [IndexAttachment]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [IndexAttachment]
indexAttachments
      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