{-# 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.Kendra.ListQuerySuggestionsBlockLists
-- 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 the block lists used for query suggestions for an index.
--
-- For information on the current quota limits for block lists, see
-- <https://docs.aws.amazon.com/kendra/latest/dg/quotas.html Quotas for Amazon Kendra>.
--
-- @ListQuerySuggestionsBlockLists@ is currently not supported in the
-- Amazon Web Services GovCloud (US-West) region.
module Amazonka.Kendra.ListQuerySuggestionsBlockLists
  ( -- * Creating a Request
    ListQuerySuggestionsBlockLists (..),
    newListQuerySuggestionsBlockLists,

    -- * Request Lenses
    listQuerySuggestionsBlockLists_maxResults,
    listQuerySuggestionsBlockLists_nextToken,
    listQuerySuggestionsBlockLists_indexId,

    -- * Destructuring the Response
    ListQuerySuggestionsBlockListsResponse (..),
    newListQuerySuggestionsBlockListsResponse,

    -- * Response Lenses
    listQuerySuggestionsBlockListsResponse_blockListSummaryItems,
    listQuerySuggestionsBlockListsResponse_nextToken,
    listQuerySuggestionsBlockListsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListQuerySuggestionsBlockLists' smart constructor.
data ListQuerySuggestionsBlockLists = ListQuerySuggestionsBlockLists'
  { -- | The maximum number of block lists to return.
    ListQuerySuggestionsBlockLists -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | If the previous response was incomplete (because there is more data to
    -- retrieve), Amazon Kendra returns a pagination token in the response. You
    -- can use this pagination token to retrieve the next set of block lists
    -- (@BlockListSummaryItems@).
    ListQuerySuggestionsBlockLists -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the index for a list of all block lists that exist for
    -- that index.
    --
    -- For information on the current quota limits for block lists, see
    -- <https://docs.aws.amazon.com/kendra/latest/dg/quotas.html Quotas for Amazon Kendra>.
    ListQuerySuggestionsBlockLists -> Text
indexId :: Prelude.Text
  }
  deriving (ListQuerySuggestionsBlockLists
-> ListQuerySuggestionsBlockLists -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListQuerySuggestionsBlockLists
-> ListQuerySuggestionsBlockLists -> Bool
$c/= :: ListQuerySuggestionsBlockLists
-> ListQuerySuggestionsBlockLists -> Bool
== :: ListQuerySuggestionsBlockLists
-> ListQuerySuggestionsBlockLists -> Bool
$c== :: ListQuerySuggestionsBlockLists
-> ListQuerySuggestionsBlockLists -> Bool
Prelude.Eq, ReadPrec [ListQuerySuggestionsBlockLists]
ReadPrec ListQuerySuggestionsBlockLists
Int -> ReadS ListQuerySuggestionsBlockLists
ReadS [ListQuerySuggestionsBlockLists]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListQuerySuggestionsBlockLists]
$creadListPrec :: ReadPrec [ListQuerySuggestionsBlockLists]
readPrec :: ReadPrec ListQuerySuggestionsBlockLists
$creadPrec :: ReadPrec ListQuerySuggestionsBlockLists
readList :: ReadS [ListQuerySuggestionsBlockLists]
$creadList :: ReadS [ListQuerySuggestionsBlockLists]
readsPrec :: Int -> ReadS ListQuerySuggestionsBlockLists
$creadsPrec :: Int -> ReadS ListQuerySuggestionsBlockLists
Prelude.Read, Int -> ListQuerySuggestionsBlockLists -> ShowS
[ListQuerySuggestionsBlockLists] -> ShowS
ListQuerySuggestionsBlockLists -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListQuerySuggestionsBlockLists] -> ShowS
$cshowList :: [ListQuerySuggestionsBlockLists] -> ShowS
show :: ListQuerySuggestionsBlockLists -> String
$cshow :: ListQuerySuggestionsBlockLists -> String
showsPrec :: Int -> ListQuerySuggestionsBlockLists -> ShowS
$cshowsPrec :: Int -> ListQuerySuggestionsBlockLists -> ShowS
Prelude.Show, forall x.
Rep ListQuerySuggestionsBlockLists x
-> ListQuerySuggestionsBlockLists
forall x.
ListQuerySuggestionsBlockLists
-> Rep ListQuerySuggestionsBlockLists x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListQuerySuggestionsBlockLists x
-> ListQuerySuggestionsBlockLists
$cfrom :: forall x.
ListQuerySuggestionsBlockLists
-> Rep ListQuerySuggestionsBlockLists x
Prelude.Generic)

-- |
-- Create a value of 'ListQuerySuggestionsBlockLists' 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', 'listQuerySuggestionsBlockLists_maxResults' - The maximum number of block lists to return.
--
-- 'nextToken', 'listQuerySuggestionsBlockLists_nextToken' - If the previous response was incomplete (because there is more data to
-- retrieve), Amazon Kendra returns a pagination token in the response. You
-- can use this pagination token to retrieve the next set of block lists
-- (@BlockListSummaryItems@).
--
-- 'indexId', 'listQuerySuggestionsBlockLists_indexId' - The identifier of the index for a list of all block lists that exist for
-- that index.
--
-- For information on the current quota limits for block lists, see
-- <https://docs.aws.amazon.com/kendra/latest/dg/quotas.html Quotas for Amazon Kendra>.
newListQuerySuggestionsBlockLists ::
  -- | 'indexId'
  Prelude.Text ->
  ListQuerySuggestionsBlockLists
newListQuerySuggestionsBlockLists :: Text -> ListQuerySuggestionsBlockLists
newListQuerySuggestionsBlockLists Text
pIndexId_ =
  ListQuerySuggestionsBlockLists'
    { $sel:maxResults:ListQuerySuggestionsBlockLists' :: Maybe Natural
maxResults =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListQuerySuggestionsBlockLists' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:indexId:ListQuerySuggestionsBlockLists' :: Text
indexId = Text
pIndexId_
    }

-- | The maximum number of block lists to return.
listQuerySuggestionsBlockLists_maxResults :: Lens.Lens' ListQuerySuggestionsBlockLists (Prelude.Maybe Prelude.Natural)
listQuerySuggestionsBlockLists_maxResults :: Lens' ListQuerySuggestionsBlockLists (Maybe Natural)
listQuerySuggestionsBlockLists_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQuerySuggestionsBlockLists' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListQuerySuggestionsBlockLists' :: ListQuerySuggestionsBlockLists -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListQuerySuggestionsBlockLists
s@ListQuerySuggestionsBlockLists' {} Maybe Natural
a -> ListQuerySuggestionsBlockLists
s {$sel:maxResults:ListQuerySuggestionsBlockLists' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListQuerySuggestionsBlockLists)

-- | If the previous response was incomplete (because there is more data to
-- retrieve), Amazon Kendra returns a pagination token in the response. You
-- can use this pagination token to retrieve the next set of block lists
-- (@BlockListSummaryItems@).
listQuerySuggestionsBlockLists_nextToken :: Lens.Lens' ListQuerySuggestionsBlockLists (Prelude.Maybe Prelude.Text)
listQuerySuggestionsBlockLists_nextToken :: Lens' ListQuerySuggestionsBlockLists (Maybe Text)
listQuerySuggestionsBlockLists_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQuerySuggestionsBlockLists' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListQuerySuggestionsBlockLists' :: ListQuerySuggestionsBlockLists -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListQuerySuggestionsBlockLists
s@ListQuerySuggestionsBlockLists' {} Maybe Text
a -> ListQuerySuggestionsBlockLists
s {$sel:nextToken:ListQuerySuggestionsBlockLists' :: Maybe Text
nextToken = Maybe Text
a} :: ListQuerySuggestionsBlockLists)

-- | The identifier of the index for a list of all block lists that exist for
-- that index.
--
-- For information on the current quota limits for block lists, see
-- <https://docs.aws.amazon.com/kendra/latest/dg/quotas.html Quotas for Amazon Kendra>.
listQuerySuggestionsBlockLists_indexId :: Lens.Lens' ListQuerySuggestionsBlockLists Prelude.Text
listQuerySuggestionsBlockLists_indexId :: Lens' ListQuerySuggestionsBlockLists Text
listQuerySuggestionsBlockLists_indexId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQuerySuggestionsBlockLists' {Text
indexId :: Text
$sel:indexId:ListQuerySuggestionsBlockLists' :: ListQuerySuggestionsBlockLists -> Text
indexId} -> Text
indexId) (\s :: ListQuerySuggestionsBlockLists
s@ListQuerySuggestionsBlockLists' {} Text
a -> ListQuerySuggestionsBlockLists
s {$sel:indexId:ListQuerySuggestionsBlockLists' :: Text
indexId = Text
a} :: ListQuerySuggestionsBlockLists)

instance
  Core.AWSRequest
    ListQuerySuggestionsBlockLists
  where
  type
    AWSResponse ListQuerySuggestionsBlockLists =
      ListQuerySuggestionsBlockListsResponse
  request :: (Service -> Service)
-> ListQuerySuggestionsBlockLists
-> Request ListQuerySuggestionsBlockLists
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 ListQuerySuggestionsBlockLists
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse ListQuerySuggestionsBlockLists)))
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 [QuerySuggestionsBlockListSummary]
-> Maybe Text -> Int -> ListQuerySuggestionsBlockListsResponse
ListQuerySuggestionsBlockListsResponse'
            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
"BlockListSummaryItems"
                            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
    ListQuerySuggestionsBlockLists
  where
  hashWithSalt :: Int -> ListQuerySuggestionsBlockLists -> Int
hashWithSalt
    Int
_salt
    ListQuerySuggestionsBlockLists' {Maybe Natural
Maybe Text
Text
indexId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:indexId:ListQuerySuggestionsBlockLists' :: ListQuerySuggestionsBlockLists -> Text
$sel:nextToken:ListQuerySuggestionsBlockLists' :: ListQuerySuggestionsBlockLists -> Maybe Text
$sel:maxResults:ListQuerySuggestionsBlockLists' :: ListQuerySuggestionsBlockLists -> 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` Text
indexId

instance
  Prelude.NFData
    ListQuerySuggestionsBlockLists
  where
  rnf :: ListQuerySuggestionsBlockLists -> ()
rnf ListQuerySuggestionsBlockLists' {Maybe Natural
Maybe Text
Text
indexId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:indexId:ListQuerySuggestionsBlockLists' :: ListQuerySuggestionsBlockLists -> Text
$sel:nextToken:ListQuerySuggestionsBlockLists' :: ListQuerySuggestionsBlockLists -> Maybe Text
$sel:maxResults:ListQuerySuggestionsBlockLists' :: ListQuerySuggestionsBlockLists -> 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 Text
indexId

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

instance Data.ToJSON ListQuerySuggestionsBlockLists where
  toJSON :: ListQuerySuggestionsBlockLists -> Value
toJSON ListQuerySuggestionsBlockLists' {Maybe Natural
Maybe Text
Text
indexId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:indexId:ListQuerySuggestionsBlockLists' :: ListQuerySuggestionsBlockLists -> Text
$sel:nextToken:ListQuerySuggestionsBlockLists' :: ListQuerySuggestionsBlockLists -> Maybe Text
$sel:maxResults:ListQuerySuggestionsBlockLists' :: ListQuerySuggestionsBlockLists -> 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,
            forall a. a -> Maybe a
Prelude.Just (Key
"IndexId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
indexId)
          ]
      )

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

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

-- | /See:/ 'newListQuerySuggestionsBlockListsResponse' smart constructor.
data ListQuerySuggestionsBlockListsResponse = ListQuerySuggestionsBlockListsResponse'
  { -- | Summary items for a block list.
    --
    -- This includes summary items on the block list ID, block list name, when
    -- the block list was created, when the block list was last updated, and
    -- the count of block words\/phrases in the block list.
    --
    -- For information on the current quota limits for block lists, see
    -- <https://docs.aws.amazon.com/kendra/latest/dg/quotas.html Quotas for Amazon Kendra>.
    ListQuerySuggestionsBlockListsResponse
-> Maybe [QuerySuggestionsBlockListSummary]
blockListSummaryItems :: Prelude.Maybe [QuerySuggestionsBlockListSummary],
    -- | If the response is truncated, Amazon Kendra returns this token that you
    -- can use in the subsequent request to retrieve the next set of block
    -- lists.
    ListQuerySuggestionsBlockListsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListQuerySuggestionsBlockListsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListQuerySuggestionsBlockListsResponse
-> ListQuerySuggestionsBlockListsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListQuerySuggestionsBlockListsResponse
-> ListQuerySuggestionsBlockListsResponse -> Bool
$c/= :: ListQuerySuggestionsBlockListsResponse
-> ListQuerySuggestionsBlockListsResponse -> Bool
== :: ListQuerySuggestionsBlockListsResponse
-> ListQuerySuggestionsBlockListsResponse -> Bool
$c== :: ListQuerySuggestionsBlockListsResponse
-> ListQuerySuggestionsBlockListsResponse -> Bool
Prelude.Eq, ReadPrec [ListQuerySuggestionsBlockListsResponse]
ReadPrec ListQuerySuggestionsBlockListsResponse
Int -> ReadS ListQuerySuggestionsBlockListsResponse
ReadS [ListQuerySuggestionsBlockListsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListQuerySuggestionsBlockListsResponse]
$creadListPrec :: ReadPrec [ListQuerySuggestionsBlockListsResponse]
readPrec :: ReadPrec ListQuerySuggestionsBlockListsResponse
$creadPrec :: ReadPrec ListQuerySuggestionsBlockListsResponse
readList :: ReadS [ListQuerySuggestionsBlockListsResponse]
$creadList :: ReadS [ListQuerySuggestionsBlockListsResponse]
readsPrec :: Int -> ReadS ListQuerySuggestionsBlockListsResponse
$creadsPrec :: Int -> ReadS ListQuerySuggestionsBlockListsResponse
Prelude.Read, Int -> ListQuerySuggestionsBlockListsResponse -> ShowS
[ListQuerySuggestionsBlockListsResponse] -> ShowS
ListQuerySuggestionsBlockListsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListQuerySuggestionsBlockListsResponse] -> ShowS
$cshowList :: [ListQuerySuggestionsBlockListsResponse] -> ShowS
show :: ListQuerySuggestionsBlockListsResponse -> String
$cshow :: ListQuerySuggestionsBlockListsResponse -> String
showsPrec :: Int -> ListQuerySuggestionsBlockListsResponse -> ShowS
$cshowsPrec :: Int -> ListQuerySuggestionsBlockListsResponse -> ShowS
Prelude.Show, forall x.
Rep ListQuerySuggestionsBlockListsResponse x
-> ListQuerySuggestionsBlockListsResponse
forall x.
ListQuerySuggestionsBlockListsResponse
-> Rep ListQuerySuggestionsBlockListsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListQuerySuggestionsBlockListsResponse x
-> ListQuerySuggestionsBlockListsResponse
$cfrom :: forall x.
ListQuerySuggestionsBlockListsResponse
-> Rep ListQuerySuggestionsBlockListsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListQuerySuggestionsBlockListsResponse' 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:
--
-- 'blockListSummaryItems', 'listQuerySuggestionsBlockListsResponse_blockListSummaryItems' - Summary items for a block list.
--
-- This includes summary items on the block list ID, block list name, when
-- the block list was created, when the block list was last updated, and
-- the count of block words\/phrases in the block list.
--
-- For information on the current quota limits for block lists, see
-- <https://docs.aws.amazon.com/kendra/latest/dg/quotas.html Quotas for Amazon Kendra>.
--
-- 'nextToken', 'listQuerySuggestionsBlockListsResponse_nextToken' - If the response is truncated, Amazon Kendra returns this token that you
-- can use in the subsequent request to retrieve the next set of block
-- lists.
--
-- 'httpStatus', 'listQuerySuggestionsBlockListsResponse_httpStatus' - The response's http status code.
newListQuerySuggestionsBlockListsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListQuerySuggestionsBlockListsResponse
newListQuerySuggestionsBlockListsResponse :: Int -> ListQuerySuggestionsBlockListsResponse
newListQuerySuggestionsBlockListsResponse
  Int
pHttpStatus_ =
    ListQuerySuggestionsBlockListsResponse'
      { $sel:blockListSummaryItems:ListQuerySuggestionsBlockListsResponse' :: Maybe [QuerySuggestionsBlockListSummary]
blockListSummaryItems =
          forall a. Maybe a
Prelude.Nothing,
        $sel:nextToken:ListQuerySuggestionsBlockListsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:ListQuerySuggestionsBlockListsResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | Summary items for a block list.
--
-- This includes summary items on the block list ID, block list name, when
-- the block list was created, when the block list was last updated, and
-- the count of block words\/phrases in the block list.
--
-- For information on the current quota limits for block lists, see
-- <https://docs.aws.amazon.com/kendra/latest/dg/quotas.html Quotas for Amazon Kendra>.
listQuerySuggestionsBlockListsResponse_blockListSummaryItems :: Lens.Lens' ListQuerySuggestionsBlockListsResponse (Prelude.Maybe [QuerySuggestionsBlockListSummary])
listQuerySuggestionsBlockListsResponse_blockListSummaryItems :: Lens'
  ListQuerySuggestionsBlockListsResponse
  (Maybe [QuerySuggestionsBlockListSummary])
listQuerySuggestionsBlockListsResponse_blockListSummaryItems = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQuerySuggestionsBlockListsResponse' {Maybe [QuerySuggestionsBlockListSummary]
blockListSummaryItems :: Maybe [QuerySuggestionsBlockListSummary]
$sel:blockListSummaryItems:ListQuerySuggestionsBlockListsResponse' :: ListQuerySuggestionsBlockListsResponse
-> Maybe [QuerySuggestionsBlockListSummary]
blockListSummaryItems} -> Maybe [QuerySuggestionsBlockListSummary]
blockListSummaryItems) (\s :: ListQuerySuggestionsBlockListsResponse
s@ListQuerySuggestionsBlockListsResponse' {} Maybe [QuerySuggestionsBlockListSummary]
a -> ListQuerySuggestionsBlockListsResponse
s {$sel:blockListSummaryItems:ListQuerySuggestionsBlockListsResponse' :: Maybe [QuerySuggestionsBlockListSummary]
blockListSummaryItems = Maybe [QuerySuggestionsBlockListSummary]
a} :: ListQuerySuggestionsBlockListsResponse) 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 the response is truncated, Amazon Kendra returns this token that you
-- can use in the subsequent request to retrieve the next set of block
-- lists.
listQuerySuggestionsBlockListsResponse_nextToken :: Lens.Lens' ListQuerySuggestionsBlockListsResponse (Prelude.Maybe Prelude.Text)
listQuerySuggestionsBlockListsResponse_nextToken :: Lens' ListQuerySuggestionsBlockListsResponse (Maybe Text)
listQuerySuggestionsBlockListsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListQuerySuggestionsBlockListsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListQuerySuggestionsBlockListsResponse' :: ListQuerySuggestionsBlockListsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListQuerySuggestionsBlockListsResponse
s@ListQuerySuggestionsBlockListsResponse' {} Maybe Text
a -> ListQuerySuggestionsBlockListsResponse
s {$sel:nextToken:ListQuerySuggestionsBlockListsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListQuerySuggestionsBlockListsResponse)

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

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