{-# 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.Query
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Searches an active index. Use this API to search your documents using
-- query. The @Query@ API enables to do faceted search and to filter
-- results based on document attributes.
--
-- It also enables you to provide user context that Amazon Kendra uses to
-- enforce document access control in the search results.
--
-- Amazon Kendra searches your index for text content and question and
-- answer (FAQ) content. By default the response contains three types of
-- results.
--
-- -   Relevant passages
--
-- -   Matching FAQs
--
-- -   Relevant documents
--
-- You can specify that the query return only one type of result using the
-- @QueryResultTypeConfig@ parameter.
--
-- Each query returns the 100 most relevant results.
module Amazonka.Kendra.Query
  ( -- * Creating a Request
    Query (..),
    newQuery,

    -- * Request Lenses
    query_attributeFilter,
    query_documentRelevanceOverrideConfigurations,
    query_facets,
    query_pageNumber,
    query_pageSize,
    query_queryResultTypeFilter,
    query_queryText,
    query_requestedDocumentAttributes,
    query_sortingConfiguration,
    query_spellCorrectionConfiguration,
    query_userContext,
    query_visitorId,
    query_indexId,

    -- * Destructuring the Response
    QueryResponse (..),
    newQueryResponse,

    -- * Response Lenses
    queryResponse_facetResults,
    queryResponse_queryId,
    queryResponse_resultItems,
    queryResponse_spellCorrectedQueries,
    queryResponse_totalNumberOfResults,
    queryResponse_warnings,
    queryResponse_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:/ 'newQuery' smart constructor.
data Query = Query'
  { -- | Enables filtered searches based on document attributes. You can only
    -- provide one attribute filter; however, the @AndAllFilters@, @NotFilter@,
    -- and @OrAllFilters@ parameters contain a list of other filters.
    --
    -- The @AttributeFilter@ parameter enables you to create a set of filtering
    -- rules that a document must satisfy to be included in the query results.
    Query -> Maybe AttributeFilter
attributeFilter :: Prelude.Maybe AttributeFilter,
    -- | Overrides relevance tuning configurations of fields or attributes set at
    -- the index level.
    --
    -- If you use this API to override the relevance tuning configured at the
    -- index level, but there is no relevance tuning configured at the index
    -- level, then Amazon Kendra does not apply any relevance tuning.
    --
    -- If there is relevance tuning configured at the index level, but you do
    -- not use this API to override any relevance tuning in the index, then
    -- Amazon Kendra uses the relevance tuning that is configured at the index
    -- level.
    --
    -- If there is relevance tuning configured for fields at the index level,
    -- but you use this API to override only some of these fields, then for the
    -- fields you did not override, the importance is set to 1.
    Query -> Maybe [DocumentRelevanceConfiguration]
documentRelevanceOverrideConfigurations :: Prelude.Maybe [DocumentRelevanceConfiguration],
    -- | An array of documents attributes. Amazon Kendra returns a count for each
    -- attribute key specified. This helps your users narrow their search.
    Query -> Maybe [Facet]
facets :: Prelude.Maybe [Facet],
    -- | Query results are returned in pages the size of the @PageSize@
    -- parameter. By default, Amazon Kendra returns the first page of results.
    -- Use this parameter to get result pages after the first one.
    Query -> Maybe Int
pageNumber :: Prelude.Maybe Prelude.Int,
    -- | Sets the number of results that are returned in each page of results.
    -- The default page size is 10. The maximum number of results returned is
    -- 100. If you ask for more than 100 results, only 100 are returned.
    Query -> Maybe Int
pageSize :: Prelude.Maybe Prelude.Int,
    -- | Sets the type of query. Only results for the specified query type are
    -- returned.
    Query -> Maybe QueryResultType
queryResultTypeFilter :: Prelude.Maybe QueryResultType,
    -- | The input query text for the search. Amazon Kendra truncates queries at
    -- 30 token words, which excludes punctuation and stop words. Truncation
    -- still applies if you use Boolean or more advanced, complex queries.
    Query -> Maybe Text
queryText :: Prelude.Maybe Prelude.Text,
    -- | An array of document attributes to include in the response. You can
    -- limit the response to include certain document attributes. By default
    -- all document attributes are included in the response.
    Query -> Maybe (NonEmpty Text)
requestedDocumentAttributes :: Prelude.Maybe (Prelude.NonEmpty Prelude.Text),
    -- | Provides information that determines how the results of the query are
    -- sorted. You can set the field that Amazon Kendra should sort the results
    -- on, and specify whether the results should be sorted in ascending or
    -- descending order. In the case of ties in sorting the results, the
    -- results are sorted by relevance.
    --
    -- If you don\'t provide sorting configuration, the results are sorted by
    -- the relevance that Amazon Kendra determines for the result.
    Query -> Maybe SortingConfiguration
sortingConfiguration :: Prelude.Maybe SortingConfiguration,
    -- | Enables suggested spell corrections for queries.
    Query -> Maybe SpellCorrectionConfiguration
spellCorrectionConfiguration :: Prelude.Maybe SpellCorrectionConfiguration,
    -- | The user context token or user and group information.
    Query -> Maybe UserContext
userContext :: Prelude.Maybe UserContext,
    -- | Provides an identifier for a specific user. The @VisitorId@ should be a
    -- unique identifier, such as a GUID. Don\'t use personally identifiable
    -- information, such as the user\'s email address, as the @VisitorId@.
    Query -> Maybe Text
visitorId :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the index to search. The identifier is returned in the
    -- response from the @CreateIndex@ API.
    Query -> Text
indexId :: Prelude.Text
  }
  deriving (Query -> Query -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Query -> Query -> Bool
$c/= :: Query -> Query -> Bool
== :: Query -> Query -> Bool
$c== :: Query -> Query -> Bool
Prelude.Eq, ReadPrec [Query]
ReadPrec Query
Int -> ReadS Query
ReadS [Query]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Query]
$creadListPrec :: ReadPrec [Query]
readPrec :: ReadPrec Query
$creadPrec :: ReadPrec Query
readList :: ReadS [Query]
$creadList :: ReadS [Query]
readsPrec :: Int -> ReadS Query
$creadsPrec :: Int -> ReadS Query
Prelude.Read, Int -> Query -> ShowS
[Query] -> ShowS
Query -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Query] -> ShowS
$cshowList :: [Query] -> ShowS
show :: Query -> String
$cshow :: Query -> String
showsPrec :: Int -> Query -> ShowS
$cshowsPrec :: Int -> Query -> ShowS
Prelude.Show, forall x. Rep Query x -> Query
forall x. Query -> Rep Query x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Query x -> Query
$cfrom :: forall x. Query -> Rep Query x
Prelude.Generic)

-- |
-- Create a value of 'Query' 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:
--
-- 'attributeFilter', 'query_attributeFilter' - Enables filtered searches based on document attributes. You can only
-- provide one attribute filter; however, the @AndAllFilters@, @NotFilter@,
-- and @OrAllFilters@ parameters contain a list of other filters.
--
-- The @AttributeFilter@ parameter enables you to create a set of filtering
-- rules that a document must satisfy to be included in the query results.
--
-- 'documentRelevanceOverrideConfigurations', 'query_documentRelevanceOverrideConfigurations' - Overrides relevance tuning configurations of fields or attributes set at
-- the index level.
--
-- If you use this API to override the relevance tuning configured at the
-- index level, but there is no relevance tuning configured at the index
-- level, then Amazon Kendra does not apply any relevance tuning.
--
-- If there is relevance tuning configured at the index level, but you do
-- not use this API to override any relevance tuning in the index, then
-- Amazon Kendra uses the relevance tuning that is configured at the index
-- level.
--
-- If there is relevance tuning configured for fields at the index level,
-- but you use this API to override only some of these fields, then for the
-- fields you did not override, the importance is set to 1.
--
-- 'facets', 'query_facets' - An array of documents attributes. Amazon Kendra returns a count for each
-- attribute key specified. This helps your users narrow their search.
--
-- 'pageNumber', 'query_pageNumber' - Query results are returned in pages the size of the @PageSize@
-- parameter. By default, Amazon Kendra returns the first page of results.
-- Use this parameter to get result pages after the first one.
--
-- 'pageSize', 'query_pageSize' - Sets the number of results that are returned in each page of results.
-- The default page size is 10. The maximum number of results returned is
-- 100. If you ask for more than 100 results, only 100 are returned.
--
-- 'queryResultTypeFilter', 'query_queryResultTypeFilter' - Sets the type of query. Only results for the specified query type are
-- returned.
--
-- 'queryText', 'query_queryText' - The input query text for the search. Amazon Kendra truncates queries at
-- 30 token words, which excludes punctuation and stop words. Truncation
-- still applies if you use Boolean or more advanced, complex queries.
--
-- 'requestedDocumentAttributes', 'query_requestedDocumentAttributes' - An array of document attributes to include in the response. You can
-- limit the response to include certain document attributes. By default
-- all document attributes are included in the response.
--
-- 'sortingConfiguration', 'query_sortingConfiguration' - Provides information that determines how the results of the query are
-- sorted. You can set the field that Amazon Kendra should sort the results
-- on, and specify whether the results should be sorted in ascending or
-- descending order. In the case of ties in sorting the results, the
-- results are sorted by relevance.
--
-- If you don\'t provide sorting configuration, the results are sorted by
-- the relevance that Amazon Kendra determines for the result.
--
-- 'spellCorrectionConfiguration', 'query_spellCorrectionConfiguration' - Enables suggested spell corrections for queries.
--
-- 'userContext', 'query_userContext' - The user context token or user and group information.
--
-- 'visitorId', 'query_visitorId' - Provides an identifier for a specific user. The @VisitorId@ should be a
-- unique identifier, such as a GUID. Don\'t use personally identifiable
-- information, such as the user\'s email address, as the @VisitorId@.
--
-- 'indexId', 'query_indexId' - The identifier of the index to search. The identifier is returned in the
-- response from the @CreateIndex@ API.
newQuery ::
  -- | 'indexId'
  Prelude.Text ->
  Query
newQuery :: Text -> Query
newQuery Text
pIndexId_ =
  Query'
    { $sel:attributeFilter:Query' :: Maybe AttributeFilter
attributeFilter = forall a. Maybe a
Prelude.Nothing,
      $sel:documentRelevanceOverrideConfigurations:Query' :: Maybe [DocumentRelevanceConfiguration]
documentRelevanceOverrideConfigurations =
        forall a. Maybe a
Prelude.Nothing,
      $sel:facets:Query' :: Maybe [Facet]
facets = forall a. Maybe a
Prelude.Nothing,
      $sel:pageNumber:Query' :: Maybe Int
pageNumber = forall a. Maybe a
Prelude.Nothing,
      $sel:pageSize:Query' :: Maybe Int
pageSize = forall a. Maybe a
Prelude.Nothing,
      $sel:queryResultTypeFilter:Query' :: Maybe QueryResultType
queryResultTypeFilter = forall a. Maybe a
Prelude.Nothing,
      $sel:queryText:Query' :: Maybe Text
queryText = forall a. Maybe a
Prelude.Nothing,
      $sel:requestedDocumentAttributes:Query' :: Maybe (NonEmpty Text)
requestedDocumentAttributes = forall a. Maybe a
Prelude.Nothing,
      $sel:sortingConfiguration:Query' :: Maybe SortingConfiguration
sortingConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:spellCorrectionConfiguration:Query' :: Maybe SpellCorrectionConfiguration
spellCorrectionConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:userContext:Query' :: Maybe UserContext
userContext = forall a. Maybe a
Prelude.Nothing,
      $sel:visitorId:Query' :: Maybe Text
visitorId = forall a. Maybe a
Prelude.Nothing,
      $sel:indexId:Query' :: Text
indexId = Text
pIndexId_
    }

-- | Enables filtered searches based on document attributes. You can only
-- provide one attribute filter; however, the @AndAllFilters@, @NotFilter@,
-- and @OrAllFilters@ parameters contain a list of other filters.
--
-- The @AttributeFilter@ parameter enables you to create a set of filtering
-- rules that a document must satisfy to be included in the query results.
query_attributeFilter :: Lens.Lens' Query (Prelude.Maybe AttributeFilter)
query_attributeFilter :: Lens' Query (Maybe AttributeFilter)
query_attributeFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Query' {Maybe AttributeFilter
attributeFilter :: Maybe AttributeFilter
$sel:attributeFilter:Query' :: Query -> Maybe AttributeFilter
attributeFilter} -> Maybe AttributeFilter
attributeFilter) (\s :: Query
s@Query' {} Maybe AttributeFilter
a -> Query
s {$sel:attributeFilter:Query' :: Maybe AttributeFilter
attributeFilter = Maybe AttributeFilter
a} :: Query)

-- | Overrides relevance tuning configurations of fields or attributes set at
-- the index level.
--
-- If you use this API to override the relevance tuning configured at the
-- index level, but there is no relevance tuning configured at the index
-- level, then Amazon Kendra does not apply any relevance tuning.
--
-- If there is relevance tuning configured at the index level, but you do
-- not use this API to override any relevance tuning in the index, then
-- Amazon Kendra uses the relevance tuning that is configured at the index
-- level.
--
-- If there is relevance tuning configured for fields at the index level,
-- but you use this API to override only some of these fields, then for the
-- fields you did not override, the importance is set to 1.
query_documentRelevanceOverrideConfigurations :: Lens.Lens' Query (Prelude.Maybe [DocumentRelevanceConfiguration])
query_documentRelevanceOverrideConfigurations :: Lens' Query (Maybe [DocumentRelevanceConfiguration])
query_documentRelevanceOverrideConfigurations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Query' {Maybe [DocumentRelevanceConfiguration]
documentRelevanceOverrideConfigurations :: Maybe [DocumentRelevanceConfiguration]
$sel:documentRelevanceOverrideConfigurations:Query' :: Query -> Maybe [DocumentRelevanceConfiguration]
documentRelevanceOverrideConfigurations} -> Maybe [DocumentRelevanceConfiguration]
documentRelevanceOverrideConfigurations) (\s :: Query
s@Query' {} Maybe [DocumentRelevanceConfiguration]
a -> Query
s {$sel:documentRelevanceOverrideConfigurations:Query' :: Maybe [DocumentRelevanceConfiguration]
documentRelevanceOverrideConfigurations = Maybe [DocumentRelevanceConfiguration]
a} :: Query) 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

-- | An array of documents attributes. Amazon Kendra returns a count for each
-- attribute key specified. This helps your users narrow their search.
query_facets :: Lens.Lens' Query (Prelude.Maybe [Facet])
query_facets :: Lens' Query (Maybe [Facet])
query_facets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Query' {Maybe [Facet]
facets :: Maybe [Facet]
$sel:facets:Query' :: Query -> Maybe [Facet]
facets} -> Maybe [Facet]
facets) (\s :: Query
s@Query' {} Maybe [Facet]
a -> Query
s {$sel:facets:Query' :: Maybe [Facet]
facets = Maybe [Facet]
a} :: Query) 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

-- | Query results are returned in pages the size of the @PageSize@
-- parameter. By default, Amazon Kendra returns the first page of results.
-- Use this parameter to get result pages after the first one.
query_pageNumber :: Lens.Lens' Query (Prelude.Maybe Prelude.Int)
query_pageNumber :: Lens' Query (Maybe Int)
query_pageNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Query' {Maybe Int
pageNumber :: Maybe Int
$sel:pageNumber:Query' :: Query -> Maybe Int
pageNumber} -> Maybe Int
pageNumber) (\s :: Query
s@Query' {} Maybe Int
a -> Query
s {$sel:pageNumber:Query' :: Maybe Int
pageNumber = Maybe Int
a} :: Query)

-- | Sets the number of results that are returned in each page of results.
-- The default page size is 10. The maximum number of results returned is
-- 100. If you ask for more than 100 results, only 100 are returned.
query_pageSize :: Lens.Lens' Query (Prelude.Maybe Prelude.Int)
query_pageSize :: Lens' Query (Maybe Int)
query_pageSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Query' {Maybe Int
pageSize :: Maybe Int
$sel:pageSize:Query' :: Query -> Maybe Int
pageSize} -> Maybe Int
pageSize) (\s :: Query
s@Query' {} Maybe Int
a -> Query
s {$sel:pageSize:Query' :: Maybe Int
pageSize = Maybe Int
a} :: Query)

-- | Sets the type of query. Only results for the specified query type are
-- returned.
query_queryResultTypeFilter :: Lens.Lens' Query (Prelude.Maybe QueryResultType)
query_queryResultTypeFilter :: Lens' Query (Maybe QueryResultType)
query_queryResultTypeFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Query' {Maybe QueryResultType
queryResultTypeFilter :: Maybe QueryResultType
$sel:queryResultTypeFilter:Query' :: Query -> Maybe QueryResultType
queryResultTypeFilter} -> Maybe QueryResultType
queryResultTypeFilter) (\s :: Query
s@Query' {} Maybe QueryResultType
a -> Query
s {$sel:queryResultTypeFilter:Query' :: Maybe QueryResultType
queryResultTypeFilter = Maybe QueryResultType
a} :: Query)

-- | The input query text for the search. Amazon Kendra truncates queries at
-- 30 token words, which excludes punctuation and stop words. Truncation
-- still applies if you use Boolean or more advanced, complex queries.
query_queryText :: Lens.Lens' Query (Prelude.Maybe Prelude.Text)
query_queryText :: Lens' Query (Maybe Text)
query_queryText = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Query' {Maybe Text
queryText :: Maybe Text
$sel:queryText:Query' :: Query -> Maybe Text
queryText} -> Maybe Text
queryText) (\s :: Query
s@Query' {} Maybe Text
a -> Query
s {$sel:queryText:Query' :: Maybe Text
queryText = Maybe Text
a} :: Query)

-- | An array of document attributes to include in the response. You can
-- limit the response to include certain document attributes. By default
-- all document attributes are included in the response.
query_requestedDocumentAttributes :: Lens.Lens' Query (Prelude.Maybe (Prelude.NonEmpty Prelude.Text))
query_requestedDocumentAttributes :: Lens' Query (Maybe (NonEmpty Text))
query_requestedDocumentAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Query' {Maybe (NonEmpty Text)
requestedDocumentAttributes :: Maybe (NonEmpty Text)
$sel:requestedDocumentAttributes:Query' :: Query -> Maybe (NonEmpty Text)
requestedDocumentAttributes} -> Maybe (NonEmpty Text)
requestedDocumentAttributes) (\s :: Query
s@Query' {} Maybe (NonEmpty Text)
a -> Query
s {$sel:requestedDocumentAttributes:Query' :: Maybe (NonEmpty Text)
requestedDocumentAttributes = Maybe (NonEmpty Text)
a} :: Query) 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

-- | Provides information that determines how the results of the query are
-- sorted. You can set the field that Amazon Kendra should sort the results
-- on, and specify whether the results should be sorted in ascending or
-- descending order. In the case of ties in sorting the results, the
-- results are sorted by relevance.
--
-- If you don\'t provide sorting configuration, the results are sorted by
-- the relevance that Amazon Kendra determines for the result.
query_sortingConfiguration :: Lens.Lens' Query (Prelude.Maybe SortingConfiguration)
query_sortingConfiguration :: Lens' Query (Maybe SortingConfiguration)
query_sortingConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Query' {Maybe SortingConfiguration
sortingConfiguration :: Maybe SortingConfiguration
$sel:sortingConfiguration:Query' :: Query -> Maybe SortingConfiguration
sortingConfiguration} -> Maybe SortingConfiguration
sortingConfiguration) (\s :: Query
s@Query' {} Maybe SortingConfiguration
a -> Query
s {$sel:sortingConfiguration:Query' :: Maybe SortingConfiguration
sortingConfiguration = Maybe SortingConfiguration
a} :: Query)

-- | Enables suggested spell corrections for queries.
query_spellCorrectionConfiguration :: Lens.Lens' Query (Prelude.Maybe SpellCorrectionConfiguration)
query_spellCorrectionConfiguration :: Lens' Query (Maybe SpellCorrectionConfiguration)
query_spellCorrectionConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Query' {Maybe SpellCorrectionConfiguration
spellCorrectionConfiguration :: Maybe SpellCorrectionConfiguration
$sel:spellCorrectionConfiguration:Query' :: Query -> Maybe SpellCorrectionConfiguration
spellCorrectionConfiguration} -> Maybe SpellCorrectionConfiguration
spellCorrectionConfiguration) (\s :: Query
s@Query' {} Maybe SpellCorrectionConfiguration
a -> Query
s {$sel:spellCorrectionConfiguration:Query' :: Maybe SpellCorrectionConfiguration
spellCorrectionConfiguration = Maybe SpellCorrectionConfiguration
a} :: Query)

-- | The user context token or user and group information.
query_userContext :: Lens.Lens' Query (Prelude.Maybe UserContext)
query_userContext :: Lens' Query (Maybe UserContext)
query_userContext = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Query' {Maybe UserContext
userContext :: Maybe UserContext
$sel:userContext:Query' :: Query -> Maybe UserContext
userContext} -> Maybe UserContext
userContext) (\s :: Query
s@Query' {} Maybe UserContext
a -> Query
s {$sel:userContext:Query' :: Maybe UserContext
userContext = Maybe UserContext
a} :: Query)

-- | Provides an identifier for a specific user. The @VisitorId@ should be a
-- unique identifier, such as a GUID. Don\'t use personally identifiable
-- information, such as the user\'s email address, as the @VisitorId@.
query_visitorId :: Lens.Lens' Query (Prelude.Maybe Prelude.Text)
query_visitorId :: Lens' Query (Maybe Text)
query_visitorId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Query' {Maybe Text
visitorId :: Maybe Text
$sel:visitorId:Query' :: Query -> Maybe Text
visitorId} -> Maybe Text
visitorId) (\s :: Query
s@Query' {} Maybe Text
a -> Query
s {$sel:visitorId:Query' :: Maybe Text
visitorId = Maybe Text
a} :: Query)

-- | The identifier of the index to search. The identifier is returned in the
-- response from the @CreateIndex@ API.
query_indexId :: Lens.Lens' Query Prelude.Text
query_indexId :: Lens' Query Text
query_indexId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Query' {Text
indexId :: Text
$sel:indexId:Query' :: Query -> Text
indexId} -> Text
indexId) (\s :: Query
s@Query' {} Text
a -> Query
s {$sel:indexId:Query' :: Text
indexId = Text
a} :: Query)

instance Core.AWSRequest Query where
  type AWSResponse Query = QueryResponse
  request :: (Service -> Service) -> Query -> Request Query
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 Query
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse Query)))
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 [FacetResult]
-> Maybe Text
-> Maybe [QueryResultItem]
-> Maybe [SpellCorrectedQuery]
-> Maybe Int
-> Maybe (NonEmpty Warning)
-> Int
-> QueryResponse
QueryResponse'
            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
"FacetResults" 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
"QueryId")
            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
"ResultItems" 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
"SpellCorrectedQueries"
                            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
"TotalNumberOfResults")
            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
"Warnings")
            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 Query where
  hashWithSalt :: Int -> Query -> Int
hashWithSalt Int
_salt Query' {Maybe Int
Maybe [Facet]
Maybe [DocumentRelevanceConfiguration]
Maybe (NonEmpty Text)
Maybe Text
Maybe AttributeFilter
Maybe QueryResultType
Maybe SortingConfiguration
Maybe SpellCorrectionConfiguration
Maybe UserContext
Text
indexId :: Text
visitorId :: Maybe Text
userContext :: Maybe UserContext
spellCorrectionConfiguration :: Maybe SpellCorrectionConfiguration
sortingConfiguration :: Maybe SortingConfiguration
requestedDocumentAttributes :: Maybe (NonEmpty Text)
queryText :: Maybe Text
queryResultTypeFilter :: Maybe QueryResultType
pageSize :: Maybe Int
pageNumber :: Maybe Int
facets :: Maybe [Facet]
documentRelevanceOverrideConfigurations :: Maybe [DocumentRelevanceConfiguration]
attributeFilter :: Maybe AttributeFilter
$sel:indexId:Query' :: Query -> Text
$sel:visitorId:Query' :: Query -> Maybe Text
$sel:userContext:Query' :: Query -> Maybe UserContext
$sel:spellCorrectionConfiguration:Query' :: Query -> Maybe SpellCorrectionConfiguration
$sel:sortingConfiguration:Query' :: Query -> Maybe SortingConfiguration
$sel:requestedDocumentAttributes:Query' :: Query -> Maybe (NonEmpty Text)
$sel:queryText:Query' :: Query -> Maybe Text
$sel:queryResultTypeFilter:Query' :: Query -> Maybe QueryResultType
$sel:pageSize:Query' :: Query -> Maybe Int
$sel:pageNumber:Query' :: Query -> Maybe Int
$sel:facets:Query' :: Query -> Maybe [Facet]
$sel:documentRelevanceOverrideConfigurations:Query' :: Query -> Maybe [DocumentRelevanceConfiguration]
$sel:attributeFilter:Query' :: Query -> Maybe AttributeFilter
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AttributeFilter
attributeFilter
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [DocumentRelevanceConfiguration]
documentRelevanceOverrideConfigurations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Facet]
facets
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
pageNumber
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
pageSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe QueryResultType
queryResultTypeFilter
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
queryText
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Text)
requestedDocumentAttributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SortingConfiguration
sortingConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SpellCorrectionConfiguration
spellCorrectionConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe UserContext
userContext
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
visitorId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
indexId

instance Prelude.NFData Query where
  rnf :: Query -> ()
rnf Query' {Maybe Int
Maybe [Facet]
Maybe [DocumentRelevanceConfiguration]
Maybe (NonEmpty Text)
Maybe Text
Maybe AttributeFilter
Maybe QueryResultType
Maybe SortingConfiguration
Maybe SpellCorrectionConfiguration
Maybe UserContext
Text
indexId :: Text
visitorId :: Maybe Text
userContext :: Maybe UserContext
spellCorrectionConfiguration :: Maybe SpellCorrectionConfiguration
sortingConfiguration :: Maybe SortingConfiguration
requestedDocumentAttributes :: Maybe (NonEmpty Text)
queryText :: Maybe Text
queryResultTypeFilter :: Maybe QueryResultType
pageSize :: Maybe Int
pageNumber :: Maybe Int
facets :: Maybe [Facet]
documentRelevanceOverrideConfigurations :: Maybe [DocumentRelevanceConfiguration]
attributeFilter :: Maybe AttributeFilter
$sel:indexId:Query' :: Query -> Text
$sel:visitorId:Query' :: Query -> Maybe Text
$sel:userContext:Query' :: Query -> Maybe UserContext
$sel:spellCorrectionConfiguration:Query' :: Query -> Maybe SpellCorrectionConfiguration
$sel:sortingConfiguration:Query' :: Query -> Maybe SortingConfiguration
$sel:requestedDocumentAttributes:Query' :: Query -> Maybe (NonEmpty Text)
$sel:queryText:Query' :: Query -> Maybe Text
$sel:queryResultTypeFilter:Query' :: Query -> Maybe QueryResultType
$sel:pageSize:Query' :: Query -> Maybe Int
$sel:pageNumber:Query' :: Query -> Maybe Int
$sel:facets:Query' :: Query -> Maybe [Facet]
$sel:documentRelevanceOverrideConfigurations:Query' :: Query -> Maybe [DocumentRelevanceConfiguration]
$sel:attributeFilter:Query' :: Query -> Maybe AttributeFilter
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AttributeFilter
attributeFilter
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [DocumentRelevanceConfiguration]
documentRelevanceOverrideConfigurations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Facet]
facets
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
pageNumber
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
pageSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe QueryResultType
queryResultTypeFilter
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
queryText
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Text)
requestedDocumentAttributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SortingConfiguration
sortingConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SpellCorrectionConfiguration
spellCorrectionConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe UserContext
userContext
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
visitorId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
indexId

instance Data.ToHeaders Query where
  toHeaders :: Query -> 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.Query" ::
                          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 Query where
  toJSON :: Query -> Value
toJSON Query' {Maybe Int
Maybe [Facet]
Maybe [DocumentRelevanceConfiguration]
Maybe (NonEmpty Text)
Maybe Text
Maybe AttributeFilter
Maybe QueryResultType
Maybe SortingConfiguration
Maybe SpellCorrectionConfiguration
Maybe UserContext
Text
indexId :: Text
visitorId :: Maybe Text
userContext :: Maybe UserContext
spellCorrectionConfiguration :: Maybe SpellCorrectionConfiguration
sortingConfiguration :: Maybe SortingConfiguration
requestedDocumentAttributes :: Maybe (NonEmpty Text)
queryText :: Maybe Text
queryResultTypeFilter :: Maybe QueryResultType
pageSize :: Maybe Int
pageNumber :: Maybe Int
facets :: Maybe [Facet]
documentRelevanceOverrideConfigurations :: Maybe [DocumentRelevanceConfiguration]
attributeFilter :: Maybe AttributeFilter
$sel:indexId:Query' :: Query -> Text
$sel:visitorId:Query' :: Query -> Maybe Text
$sel:userContext:Query' :: Query -> Maybe UserContext
$sel:spellCorrectionConfiguration:Query' :: Query -> Maybe SpellCorrectionConfiguration
$sel:sortingConfiguration:Query' :: Query -> Maybe SortingConfiguration
$sel:requestedDocumentAttributes:Query' :: Query -> Maybe (NonEmpty Text)
$sel:queryText:Query' :: Query -> Maybe Text
$sel:queryResultTypeFilter:Query' :: Query -> Maybe QueryResultType
$sel:pageSize:Query' :: Query -> Maybe Int
$sel:pageNumber:Query' :: Query -> Maybe Int
$sel:facets:Query' :: Query -> Maybe [Facet]
$sel:documentRelevanceOverrideConfigurations:Query' :: Query -> Maybe [DocumentRelevanceConfiguration]
$sel:attributeFilter:Query' :: Query -> Maybe AttributeFilter
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AttributeFilter" 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 AttributeFilter
attributeFilter,
            (Key
"DocumentRelevanceOverrideConfigurations" 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 [DocumentRelevanceConfiguration]
documentRelevanceOverrideConfigurations,
            (Key
"Facets" 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 [Facet]
facets,
            (Key
"PageNumber" 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 Int
pageNumber,
            (Key
"PageSize" 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 Int
pageSize,
            (Key
"QueryResultTypeFilter" 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 QueryResultType
queryResultTypeFilter,
            (Key
"QueryText" 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
queryText,
            (Key
"RequestedDocumentAttributes" 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 (NonEmpty Text)
requestedDocumentAttributes,
            (Key
"SortingConfiguration" 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 SortingConfiguration
sortingConfiguration,
            (Key
"SpellCorrectionConfiguration" 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 SpellCorrectionConfiguration
spellCorrectionConfiguration,
            (Key
"UserContext" 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 UserContext
userContext,
            (Key
"VisitorId" 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
visitorId,
            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 Query where
  toPath :: Query -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newQueryResponse' smart constructor.
data QueryResponse = QueryResponse'
  { -- | Contains the facet results. A @FacetResult@ contains the counts for each
    -- attribute key that was specified in the @Facets@ input parameter.
    QueryResponse -> Maybe [FacetResult]
facetResults :: Prelude.Maybe [FacetResult],
    -- | The identifier for the search. You use @QueryId@ to identify the search
    -- when using the feedback API.
    QueryResponse -> Maybe Text
queryId :: Prelude.Maybe Prelude.Text,
    -- | The results of the search.
    QueryResponse -> Maybe [QueryResultItem]
resultItems :: Prelude.Maybe [QueryResultItem],
    -- | A list of information related to suggested spell corrections for a
    -- query.
    QueryResponse -> Maybe [SpellCorrectedQuery]
spellCorrectedQueries :: Prelude.Maybe [SpellCorrectedQuery],
    -- | The total number of items found by the search; however, you can only
    -- retrieve up to 100 items. For example, if the search found 192 items,
    -- you can only retrieve the first 100 of the items.
    QueryResponse -> Maybe Int
totalNumberOfResults :: Prelude.Maybe Prelude.Int,
    -- | A list of warning codes and their messages on problems with your query.
    --
    -- Amazon Kendra currently only supports one type of warning, which is a
    -- warning on invalid syntax used in the query. For examples of invalid
    -- query syntax, see
    -- <https://docs.aws.amazon.com/kendra/latest/dg/searching-example.html#searching-index-query-syntax Searching with advanced query syntax>.
    QueryResponse -> Maybe (NonEmpty Warning)
warnings :: Prelude.Maybe (Prelude.NonEmpty Warning),
    -- | The response's http status code.
    QueryResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (QueryResponse -> QueryResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryResponse -> QueryResponse -> Bool
$c/= :: QueryResponse -> QueryResponse -> Bool
== :: QueryResponse -> QueryResponse -> Bool
$c== :: QueryResponse -> QueryResponse -> Bool
Prelude.Eq, ReadPrec [QueryResponse]
ReadPrec QueryResponse
Int -> ReadS QueryResponse
ReadS [QueryResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [QueryResponse]
$creadListPrec :: ReadPrec [QueryResponse]
readPrec :: ReadPrec QueryResponse
$creadPrec :: ReadPrec QueryResponse
readList :: ReadS [QueryResponse]
$creadList :: ReadS [QueryResponse]
readsPrec :: Int -> ReadS QueryResponse
$creadsPrec :: Int -> ReadS QueryResponse
Prelude.Read, Int -> QueryResponse -> ShowS
[QueryResponse] -> ShowS
QueryResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueryResponse] -> ShowS
$cshowList :: [QueryResponse] -> ShowS
show :: QueryResponse -> String
$cshow :: QueryResponse -> String
showsPrec :: Int -> QueryResponse -> ShowS
$cshowsPrec :: Int -> QueryResponse -> ShowS
Prelude.Show, forall x. Rep QueryResponse x -> QueryResponse
forall x. QueryResponse -> Rep QueryResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep QueryResponse x -> QueryResponse
$cfrom :: forall x. QueryResponse -> Rep QueryResponse x
Prelude.Generic)

-- |
-- Create a value of 'QueryResponse' 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:
--
-- 'facetResults', 'queryResponse_facetResults' - Contains the facet results. A @FacetResult@ contains the counts for each
-- attribute key that was specified in the @Facets@ input parameter.
--
-- 'queryId', 'queryResponse_queryId' - The identifier for the search. You use @QueryId@ to identify the search
-- when using the feedback API.
--
-- 'resultItems', 'queryResponse_resultItems' - The results of the search.
--
-- 'spellCorrectedQueries', 'queryResponse_spellCorrectedQueries' - A list of information related to suggested spell corrections for a
-- query.
--
-- 'totalNumberOfResults', 'queryResponse_totalNumberOfResults' - The total number of items found by the search; however, you can only
-- retrieve up to 100 items. For example, if the search found 192 items,
-- you can only retrieve the first 100 of the items.
--
-- 'warnings', 'queryResponse_warnings' - A list of warning codes and their messages on problems with your query.
--
-- Amazon Kendra currently only supports one type of warning, which is a
-- warning on invalid syntax used in the query. For examples of invalid
-- query syntax, see
-- <https://docs.aws.amazon.com/kendra/latest/dg/searching-example.html#searching-index-query-syntax Searching with advanced query syntax>.
--
-- 'httpStatus', 'queryResponse_httpStatus' - The response's http status code.
newQueryResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  QueryResponse
newQueryResponse :: Int -> QueryResponse
newQueryResponse Int
pHttpStatus_ =
  QueryResponse'
    { $sel:facetResults:QueryResponse' :: Maybe [FacetResult]
facetResults = forall a. Maybe a
Prelude.Nothing,
      $sel:queryId:QueryResponse' :: Maybe Text
queryId = forall a. Maybe a
Prelude.Nothing,
      $sel:resultItems:QueryResponse' :: Maybe [QueryResultItem]
resultItems = forall a. Maybe a
Prelude.Nothing,
      $sel:spellCorrectedQueries:QueryResponse' :: Maybe [SpellCorrectedQuery]
spellCorrectedQueries = forall a. Maybe a
Prelude.Nothing,
      $sel:totalNumberOfResults:QueryResponse' :: Maybe Int
totalNumberOfResults = forall a. Maybe a
Prelude.Nothing,
      $sel:warnings:QueryResponse' :: Maybe (NonEmpty Warning)
warnings = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:QueryResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Contains the facet results. A @FacetResult@ contains the counts for each
-- attribute key that was specified in the @Facets@ input parameter.
queryResponse_facetResults :: Lens.Lens' QueryResponse (Prelude.Maybe [FacetResult])
queryResponse_facetResults :: Lens' QueryResponse (Maybe [FacetResult])
queryResponse_facetResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\QueryResponse' {Maybe [FacetResult]
facetResults :: Maybe [FacetResult]
$sel:facetResults:QueryResponse' :: QueryResponse -> Maybe [FacetResult]
facetResults} -> Maybe [FacetResult]
facetResults) (\s :: QueryResponse
s@QueryResponse' {} Maybe [FacetResult]
a -> QueryResponse
s {$sel:facetResults:QueryResponse' :: Maybe [FacetResult]
facetResults = Maybe [FacetResult]
a} :: QueryResponse) 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 identifier for the search. You use @QueryId@ to identify the search
-- when using the feedback API.
queryResponse_queryId :: Lens.Lens' QueryResponse (Prelude.Maybe Prelude.Text)
queryResponse_queryId :: Lens' QueryResponse (Maybe Text)
queryResponse_queryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\QueryResponse' {Maybe Text
queryId :: Maybe Text
$sel:queryId:QueryResponse' :: QueryResponse -> Maybe Text
queryId} -> Maybe Text
queryId) (\s :: QueryResponse
s@QueryResponse' {} Maybe Text
a -> QueryResponse
s {$sel:queryId:QueryResponse' :: Maybe Text
queryId = Maybe Text
a} :: QueryResponse)

-- | The results of the search.
queryResponse_resultItems :: Lens.Lens' QueryResponse (Prelude.Maybe [QueryResultItem])
queryResponse_resultItems :: Lens' QueryResponse (Maybe [QueryResultItem])
queryResponse_resultItems = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\QueryResponse' {Maybe [QueryResultItem]
resultItems :: Maybe [QueryResultItem]
$sel:resultItems:QueryResponse' :: QueryResponse -> Maybe [QueryResultItem]
resultItems} -> Maybe [QueryResultItem]
resultItems) (\s :: QueryResponse
s@QueryResponse' {} Maybe [QueryResultItem]
a -> QueryResponse
s {$sel:resultItems:QueryResponse' :: Maybe [QueryResultItem]
resultItems = Maybe [QueryResultItem]
a} :: QueryResponse) 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

-- | A list of information related to suggested spell corrections for a
-- query.
queryResponse_spellCorrectedQueries :: Lens.Lens' QueryResponse (Prelude.Maybe [SpellCorrectedQuery])
queryResponse_spellCorrectedQueries :: Lens' QueryResponse (Maybe [SpellCorrectedQuery])
queryResponse_spellCorrectedQueries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\QueryResponse' {Maybe [SpellCorrectedQuery]
spellCorrectedQueries :: Maybe [SpellCorrectedQuery]
$sel:spellCorrectedQueries:QueryResponse' :: QueryResponse -> Maybe [SpellCorrectedQuery]
spellCorrectedQueries} -> Maybe [SpellCorrectedQuery]
spellCorrectedQueries) (\s :: QueryResponse
s@QueryResponse' {} Maybe [SpellCorrectedQuery]
a -> QueryResponse
s {$sel:spellCorrectedQueries:QueryResponse' :: Maybe [SpellCorrectedQuery]
spellCorrectedQueries = Maybe [SpellCorrectedQuery]
a} :: QueryResponse) 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 total number of items found by the search; however, you can only
-- retrieve up to 100 items. For example, if the search found 192 items,
-- you can only retrieve the first 100 of the items.
queryResponse_totalNumberOfResults :: Lens.Lens' QueryResponse (Prelude.Maybe Prelude.Int)
queryResponse_totalNumberOfResults :: Lens' QueryResponse (Maybe Int)
queryResponse_totalNumberOfResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\QueryResponse' {Maybe Int
totalNumberOfResults :: Maybe Int
$sel:totalNumberOfResults:QueryResponse' :: QueryResponse -> Maybe Int
totalNumberOfResults} -> Maybe Int
totalNumberOfResults) (\s :: QueryResponse
s@QueryResponse' {} Maybe Int
a -> QueryResponse
s {$sel:totalNumberOfResults:QueryResponse' :: Maybe Int
totalNumberOfResults = Maybe Int
a} :: QueryResponse)

-- | A list of warning codes and their messages on problems with your query.
--
-- Amazon Kendra currently only supports one type of warning, which is a
-- warning on invalid syntax used in the query. For examples of invalid
-- query syntax, see
-- <https://docs.aws.amazon.com/kendra/latest/dg/searching-example.html#searching-index-query-syntax Searching with advanced query syntax>.
queryResponse_warnings :: Lens.Lens' QueryResponse (Prelude.Maybe (Prelude.NonEmpty Warning))
queryResponse_warnings :: Lens' QueryResponse (Maybe (NonEmpty Warning))
queryResponse_warnings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\QueryResponse' {Maybe (NonEmpty Warning)
warnings :: Maybe (NonEmpty Warning)
$sel:warnings:QueryResponse' :: QueryResponse -> Maybe (NonEmpty Warning)
warnings} -> Maybe (NonEmpty Warning)
warnings) (\s :: QueryResponse
s@QueryResponse' {} Maybe (NonEmpty Warning)
a -> QueryResponse
s {$sel:warnings:QueryResponse' :: Maybe (NonEmpty Warning)
warnings = Maybe (NonEmpty Warning)
a} :: QueryResponse) 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 response's http status code.
queryResponse_httpStatus :: Lens.Lens' QueryResponse Prelude.Int
queryResponse_httpStatus :: Lens' QueryResponse Int
queryResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\QueryResponse' {Int
httpStatus :: Int
$sel:httpStatus:QueryResponse' :: QueryResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: QueryResponse
s@QueryResponse' {} Int
a -> QueryResponse
s {$sel:httpStatus:QueryResponse' :: Int
httpStatus = Int
a} :: QueryResponse)

instance Prelude.NFData QueryResponse where
  rnf :: QueryResponse -> ()
rnf QueryResponse' {Int
Maybe Int
Maybe [FacetResult]
Maybe [SpellCorrectedQuery]
Maybe [QueryResultItem]
Maybe (NonEmpty Warning)
Maybe Text
httpStatus :: Int
warnings :: Maybe (NonEmpty Warning)
totalNumberOfResults :: Maybe Int
spellCorrectedQueries :: Maybe [SpellCorrectedQuery]
resultItems :: Maybe [QueryResultItem]
queryId :: Maybe Text
facetResults :: Maybe [FacetResult]
$sel:httpStatus:QueryResponse' :: QueryResponse -> Int
$sel:warnings:QueryResponse' :: QueryResponse -> Maybe (NonEmpty Warning)
$sel:totalNumberOfResults:QueryResponse' :: QueryResponse -> Maybe Int
$sel:spellCorrectedQueries:QueryResponse' :: QueryResponse -> Maybe [SpellCorrectedQuery]
$sel:resultItems:QueryResponse' :: QueryResponse -> Maybe [QueryResultItem]
$sel:queryId:QueryResponse' :: QueryResponse -> Maybe Text
$sel:facetResults:QueryResponse' :: QueryResponse -> Maybe [FacetResult]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [FacetResult]
facetResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
queryId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [QueryResultItem]
resultItems
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [SpellCorrectedQuery]
spellCorrectedQueries
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
totalNumberOfResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Warning)
warnings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus