{-# 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.ResourceExplorer2.ListIndexes
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves a list of all of the indexes in Amazon Web Services Regions
-- that are currently collecting resource information for Amazon Web
-- Services Resource Explorer.
--
-- This operation returns paginated results.
module Amazonka.ResourceExplorer2.ListIndexes
  ( -- * Creating a Request
    ListIndexes (..),
    newListIndexes,

    -- * Request Lenses
    listIndexes_maxResults,
    listIndexes_nextToken,
    listIndexes_regions,
    listIndexes_type,

    -- * Destructuring the Response
    ListIndexesResponse (..),
    newListIndexesResponse,

    -- * Response Lenses
    listIndexesResponse_indexes,
    listIndexesResponse_nextToken,
    listIndexesResponse_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 Amazonka.ResourceExplorer2.Types
import qualified Amazonka.Response as Response

-- | /See:/ 'newListIndexes' smart constructor.
data ListIndexes = ListIndexes'
  { -- | The maximum number of results that you want included on each page of the
    -- response. If you do not include this parameter, it defaults to a value
    -- appropriate to the operation. If additional items exist beyond those
    -- included in the current response, the @NextToken@ response element is
    -- present and has a value (is not null). Include that value as the
    -- @NextToken@ request parameter in the next call to the operation to get
    -- the next part of the results.
    --
    -- An API operation can return fewer results than the maximum even when
    -- there are more results available. You should check @NextToken@ after
    -- every operation to ensure that you receive all of the results.
    ListIndexes -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The parameter for receiving additional results if you receive a
    -- @NextToken@ response in a previous request. A @NextToken@ response
    -- indicates that more output is available. Set this parameter to the value
    -- of the previous call\'s @NextToken@ response to indicate where the
    -- output should continue from.
    ListIndexes -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | If specified, limits the response to only information about the index in
    -- the specified list of Amazon Web Services Regions.
    ListIndexes -> Maybe [Text]
regions :: Prelude.Maybe [Prelude.Text],
    -- | If specified, limits the output to only indexes of the specified Type,
    -- either @LOCAL@ or @AGGREGATOR@.
    --
    -- Use this option to discover the aggregator index for your account.
    ListIndexes -> Maybe IndexType
type' :: Prelude.Maybe IndexType
  }
  deriving (ListIndexes -> ListIndexes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListIndexes -> ListIndexes -> Bool
$c/= :: ListIndexes -> ListIndexes -> Bool
== :: ListIndexes -> ListIndexes -> Bool
$c== :: ListIndexes -> ListIndexes -> Bool
Prelude.Eq, ReadPrec [ListIndexes]
ReadPrec ListIndexes
Int -> ReadS ListIndexes
ReadS [ListIndexes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListIndexes]
$creadListPrec :: ReadPrec [ListIndexes]
readPrec :: ReadPrec ListIndexes
$creadPrec :: ReadPrec ListIndexes
readList :: ReadS [ListIndexes]
$creadList :: ReadS [ListIndexes]
readsPrec :: Int -> ReadS ListIndexes
$creadsPrec :: Int -> ReadS ListIndexes
Prelude.Read, Int -> ListIndexes -> ShowS
[ListIndexes] -> ShowS
ListIndexes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListIndexes] -> ShowS
$cshowList :: [ListIndexes] -> ShowS
show :: ListIndexes -> String
$cshow :: ListIndexes -> String
showsPrec :: Int -> ListIndexes -> ShowS
$cshowsPrec :: Int -> ListIndexes -> ShowS
Prelude.Show, forall x. Rep ListIndexes x -> ListIndexes
forall x. ListIndexes -> Rep ListIndexes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListIndexes x -> ListIndexes
$cfrom :: forall x. ListIndexes -> Rep ListIndexes x
Prelude.Generic)

-- |
-- Create a value of 'ListIndexes' 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:
--
-- 'maxResults', 'listIndexes_maxResults' - The maximum number of results that you want included on each page of the
-- response. If you do not include this parameter, it defaults to a value
-- appropriate to the operation. If additional items exist beyond those
-- included in the current response, the @NextToken@ response element is
-- present and has a value (is not null). Include that value as the
-- @NextToken@ request parameter in the next call to the operation to get
-- the next part of the results.
--
-- An API operation can return fewer results than the maximum even when
-- there are more results available. You should check @NextToken@ after
-- every operation to ensure that you receive all of the results.
--
-- 'nextToken', 'listIndexes_nextToken' - The parameter for receiving additional results if you receive a
-- @NextToken@ response in a previous request. A @NextToken@ response
-- indicates that more output is available. Set this parameter to the value
-- of the previous call\'s @NextToken@ response to indicate where the
-- output should continue from.
--
-- 'regions', 'listIndexes_regions' - If specified, limits the response to only information about the index in
-- the specified list of Amazon Web Services Regions.
--
-- 'type'', 'listIndexes_type' - If specified, limits the output to only indexes of the specified Type,
-- either @LOCAL@ or @AGGREGATOR@.
--
-- Use this option to discover the aggregator index for your account.
newListIndexes ::
  ListIndexes
newListIndexes :: ListIndexes
newListIndexes =
  ListIndexes'
    { $sel:maxResults:ListIndexes' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListIndexes' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:regions:ListIndexes' :: Maybe [Text]
regions = forall a. Maybe a
Prelude.Nothing,
      $sel:type':ListIndexes' :: Maybe IndexType
type' = forall a. Maybe a
Prelude.Nothing
    }

-- | The maximum number of results that you want included on each page of the
-- response. If you do not include this parameter, it defaults to a value
-- appropriate to the operation. If additional items exist beyond those
-- included in the current response, the @NextToken@ response element is
-- present and has a value (is not null). Include that value as the
-- @NextToken@ request parameter in the next call to the operation to get
-- the next part of the results.
--
-- An API operation can return fewer results than the maximum even when
-- there are more results available. You should check @NextToken@ after
-- every operation to ensure that you receive all of the results.
listIndexes_maxResults :: Lens.Lens' ListIndexes (Prelude.Maybe Prelude.Natural)
listIndexes_maxResults :: Lens' ListIndexes (Maybe Natural)
listIndexes_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListIndexes' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListIndexes' :: ListIndexes -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListIndexes
s@ListIndexes' {} Maybe Natural
a -> ListIndexes
s {$sel:maxResults:ListIndexes' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListIndexes)

-- | The parameter for receiving additional results if you receive a
-- @NextToken@ response in a previous request. A @NextToken@ response
-- indicates that more output is available. Set this parameter to the value
-- of the previous call\'s @NextToken@ response to indicate where the
-- output should continue from.
listIndexes_nextToken :: Lens.Lens' ListIndexes (Prelude.Maybe Prelude.Text)
listIndexes_nextToken :: Lens' ListIndexes (Maybe Text)
listIndexes_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListIndexes' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListIndexes' :: ListIndexes -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListIndexes
s@ListIndexes' {} Maybe Text
a -> ListIndexes
s {$sel:nextToken:ListIndexes' :: Maybe Text
nextToken = Maybe Text
a} :: ListIndexes)

-- | If specified, limits the response to only information about the index in
-- the specified list of Amazon Web Services Regions.
listIndexes_regions :: Lens.Lens' ListIndexes (Prelude.Maybe [Prelude.Text])
listIndexes_regions :: Lens' ListIndexes (Maybe [Text])
listIndexes_regions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListIndexes' {Maybe [Text]
regions :: Maybe [Text]
$sel:regions:ListIndexes' :: ListIndexes -> Maybe [Text]
regions} -> Maybe [Text]
regions) (\s :: ListIndexes
s@ListIndexes' {} Maybe [Text]
a -> ListIndexes
s {$sel:regions:ListIndexes' :: Maybe [Text]
regions = Maybe [Text]
a} :: ListIndexes) 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

-- | If specified, limits the output to only indexes of the specified Type,
-- either @LOCAL@ or @AGGREGATOR@.
--
-- Use this option to discover the aggregator index for your account.
listIndexes_type :: Lens.Lens' ListIndexes (Prelude.Maybe IndexType)
listIndexes_type :: Lens' ListIndexes (Maybe IndexType)
listIndexes_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListIndexes' {Maybe IndexType
type' :: Maybe IndexType
$sel:type':ListIndexes' :: ListIndexes -> Maybe IndexType
type'} -> Maybe IndexType
type') (\s :: ListIndexes
s@ListIndexes' {} Maybe IndexType
a -> ListIndexes
s {$sel:type':ListIndexes' :: Maybe IndexType
type' = Maybe IndexType
a} :: ListIndexes)

instance Core.AWSPager ListIndexes where
  page :: ListIndexes -> AWSResponse ListIndexes -> Maybe ListIndexes
page ListIndexes
rq AWSResponse ListIndexes
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListIndexes
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListIndexesResponse (Maybe Text)
listIndexesResponse_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 ListIndexes
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListIndexesResponse (Maybe [Index])
listIndexesResponse_indexes
            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.$ ListIndexes
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListIndexes (Maybe Text)
listIndexes_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListIndexes
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListIndexesResponse (Maybe Text)
listIndexesResponse_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 ListIndexes where
  type AWSResponse ListIndexes = ListIndexesResponse
  request :: (Service -> Service) -> ListIndexes -> Request ListIndexes
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 ListIndexes
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListIndexes)))
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 [Index] -> Maybe Text -> Int -> ListIndexesResponse
ListIndexesResponse'
            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
"Indexes" 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 ListIndexes where
  hashWithSalt :: Int -> ListIndexes -> Int
hashWithSalt Int
_salt ListIndexes' {Maybe Natural
Maybe [Text]
Maybe Text
Maybe IndexType
type' :: Maybe IndexType
regions :: Maybe [Text]
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:type':ListIndexes' :: ListIndexes -> Maybe IndexType
$sel:regions:ListIndexes' :: ListIndexes -> Maybe [Text]
$sel:nextToken:ListIndexes' :: ListIndexes -> Maybe Text
$sel:maxResults:ListIndexes' :: ListIndexes -> Maybe Natural
..} =
    Int
_salt
      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 [Text]
regions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe IndexType
type'

instance Prelude.NFData ListIndexes where
  rnf :: ListIndexes -> ()
rnf ListIndexes' {Maybe Natural
Maybe [Text]
Maybe Text
Maybe IndexType
type' :: Maybe IndexType
regions :: Maybe [Text]
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:type':ListIndexes' :: ListIndexes -> Maybe IndexType
$sel:regions:ListIndexes' :: ListIndexes -> Maybe [Text]
$sel:nextToken:ListIndexes' :: ListIndexes -> Maybe Text
$sel:maxResults:ListIndexes' :: ListIndexes -> Maybe Natural
..} =
    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 [Text]
regions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe IndexType
type'

instance Data.ToHeaders ListIndexes where
  toHeaders :: ListIndexes -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ListIndexes where
  toJSON :: ListIndexes -> Value
toJSON ListIndexes' {Maybe Natural
Maybe [Text]
Maybe Text
Maybe IndexType
type' :: Maybe IndexType
regions :: Maybe [Text]
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:type':ListIndexes' :: ListIndexes -> Maybe IndexType
$sel:regions:ListIndexes' :: ListIndexes -> Maybe [Text]
$sel:nextToken:ListIndexes' :: ListIndexes -> Maybe Text
$sel:maxResults:ListIndexes' :: ListIndexes -> Maybe Natural
..} =
    [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
"Regions" 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]
regions,
            (Key
"Type" 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 IndexType
type'
          ]
      )

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

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

-- | /See:/ 'newListIndexesResponse' smart constructor.
data ListIndexesResponse = ListIndexesResponse'
  { -- | A structure that contains the details and status of each index.
    ListIndexesResponse -> Maybe [Index]
indexes :: Prelude.Maybe [Index],
    -- | If present, indicates that more output is available than is included in
    -- the current response. Use this value in the @NextToken@ request
    -- parameter in a subsequent call to the operation to get the next part of
    -- the output. You should repeat this until the @NextToken@ response
    -- element comes back as @null@.
    ListIndexesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListIndexesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListIndexesResponse -> ListIndexesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListIndexesResponse -> ListIndexesResponse -> Bool
$c/= :: ListIndexesResponse -> ListIndexesResponse -> Bool
== :: ListIndexesResponse -> ListIndexesResponse -> Bool
$c== :: ListIndexesResponse -> ListIndexesResponse -> Bool
Prelude.Eq, ReadPrec [ListIndexesResponse]
ReadPrec ListIndexesResponse
Int -> ReadS ListIndexesResponse
ReadS [ListIndexesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListIndexesResponse]
$creadListPrec :: ReadPrec [ListIndexesResponse]
readPrec :: ReadPrec ListIndexesResponse
$creadPrec :: ReadPrec ListIndexesResponse
readList :: ReadS [ListIndexesResponse]
$creadList :: ReadS [ListIndexesResponse]
readsPrec :: Int -> ReadS ListIndexesResponse
$creadsPrec :: Int -> ReadS ListIndexesResponse
Prelude.Read, Int -> ListIndexesResponse -> ShowS
[ListIndexesResponse] -> ShowS
ListIndexesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListIndexesResponse] -> ShowS
$cshowList :: [ListIndexesResponse] -> ShowS
show :: ListIndexesResponse -> String
$cshow :: ListIndexesResponse -> String
showsPrec :: Int -> ListIndexesResponse -> ShowS
$cshowsPrec :: Int -> ListIndexesResponse -> ShowS
Prelude.Show, forall x. Rep ListIndexesResponse x -> ListIndexesResponse
forall x. ListIndexesResponse -> Rep ListIndexesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListIndexesResponse x -> ListIndexesResponse
$cfrom :: forall x. ListIndexesResponse -> Rep ListIndexesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListIndexesResponse' 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:
--
-- 'indexes', 'listIndexesResponse_indexes' - A structure that contains the details and status of each index.
--
-- 'nextToken', 'listIndexesResponse_nextToken' - If present, indicates that more output is available than is included in
-- the current response. Use this value in the @NextToken@ request
-- parameter in a subsequent call to the operation to get the next part of
-- the output. You should repeat this until the @NextToken@ response
-- element comes back as @null@.
--
-- 'httpStatus', 'listIndexesResponse_httpStatus' - The response's http status code.
newListIndexesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListIndexesResponse
newListIndexesResponse :: Int -> ListIndexesResponse
newListIndexesResponse Int
pHttpStatus_ =
  ListIndexesResponse'
    { $sel:indexes:ListIndexesResponse' :: Maybe [Index]
indexes = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListIndexesResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListIndexesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A structure that contains the details and status of each index.
listIndexesResponse_indexes :: Lens.Lens' ListIndexesResponse (Prelude.Maybe [Index])
listIndexesResponse_indexes :: Lens' ListIndexesResponse (Maybe [Index])
listIndexesResponse_indexes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListIndexesResponse' {Maybe [Index]
indexes :: Maybe [Index]
$sel:indexes:ListIndexesResponse' :: ListIndexesResponse -> Maybe [Index]
indexes} -> Maybe [Index]
indexes) (\s :: ListIndexesResponse
s@ListIndexesResponse' {} Maybe [Index]
a -> ListIndexesResponse
s {$sel:indexes:ListIndexesResponse' :: Maybe [Index]
indexes = Maybe [Index]
a} :: ListIndexesResponse) 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

-- | If present, indicates that more output is available than is included in
-- the current response. Use this value in the @NextToken@ request
-- parameter in a subsequent call to the operation to get the next part of
-- the output. You should repeat this until the @NextToken@ response
-- element comes back as @null@.
listIndexesResponse_nextToken :: Lens.Lens' ListIndexesResponse (Prelude.Maybe Prelude.Text)
listIndexesResponse_nextToken :: Lens' ListIndexesResponse (Maybe Text)
listIndexesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListIndexesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListIndexesResponse' :: ListIndexesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListIndexesResponse
s@ListIndexesResponse' {} Maybe Text
a -> ListIndexesResponse
s {$sel:nextToken:ListIndexesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListIndexesResponse)

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

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