{-# 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.UpdateQuerySuggestionsConfig
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the settings of query suggestions for an index.
--
-- Amazon Kendra supports partial updates, so you only need to provide the
-- fields you want to update.
--
-- If an update is currently processing (i.e. \'happening\'), you need to
-- wait for the update to finish before making another update.
--
-- Updates to query suggestions settings might not take effect right away.
-- The time for your updated settings to take effect depends on the updates
-- made and the number of search queries in your index.
--
-- You can still enable\/disable query suggestions at any time.
--
-- @UpdateQuerySuggestionsConfig@ is currently not supported in the Amazon
-- Web Services GovCloud (US-West) region.
module Amazonka.Kendra.UpdateQuerySuggestionsConfig
  ( -- * Creating a Request
    UpdateQuerySuggestionsConfig (..),
    newUpdateQuerySuggestionsConfig,

    -- * Request Lenses
    updateQuerySuggestionsConfig_includeQueriesWithoutUserInformation,
    updateQuerySuggestionsConfig_minimumNumberOfQueryingUsers,
    updateQuerySuggestionsConfig_minimumQueryCount,
    updateQuerySuggestionsConfig_mode,
    updateQuerySuggestionsConfig_queryLogLookBackWindowInDays,
    updateQuerySuggestionsConfig_indexId,

    -- * Destructuring the Response
    UpdateQuerySuggestionsConfigResponse (..),
    newUpdateQuerySuggestionsConfigResponse,
  )
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:/ 'newUpdateQuerySuggestionsConfig' smart constructor.
data UpdateQuerySuggestionsConfig = UpdateQuerySuggestionsConfig'
  { -- | @TRUE@ to include queries without user information (i.e. all queries,
    -- irrespective of the user), otherwise @FALSE@ to only include queries
    -- with user information.
    --
    -- If you pass user information to Amazon Kendra along with the queries,
    -- you can set this flag to @FALSE@ and instruct Amazon Kendra to only
    -- consider queries with user information.
    --
    -- If you set to @FALSE@, Amazon Kendra only considers queries searched at
    -- least @MinimumQueryCount@ times across @MinimumNumberOfQueryingUsers@
    -- unique users for suggestions.
    --
    -- If you set to @TRUE@, Amazon Kendra ignores all user information and
    -- learns from all queries.
    UpdateQuerySuggestionsConfig -> Maybe Bool
includeQueriesWithoutUserInformation :: Prelude.Maybe Prelude.Bool,
    -- | The minimum number of unique users who must search a query in order for
    -- the query to be eligible to suggest to your users.
    --
    -- Increasing this number might decrease the number of suggestions.
    -- However, this ensures a query is searched by many users and is truly
    -- popular to suggest to users.
    --
    -- How you tune this setting depends on your specific needs.
    UpdateQuerySuggestionsConfig -> Maybe Natural
minimumNumberOfQueryingUsers :: Prelude.Maybe Prelude.Natural,
    -- | The the minimum number of times a query must be searched in order to be
    -- eligible to suggest to your users.
    --
    -- Decreasing this number increases the number of suggestions. However,
    -- this affects the quality of suggestions as it sets a low bar for a query
    -- to be considered popular to suggest to users.
    --
    -- How you tune this setting depends on your specific needs.
    UpdateQuerySuggestionsConfig -> Maybe Natural
minimumQueryCount :: Prelude.Maybe Prelude.Natural,
    -- | Set the mode to @ENABLED@ or @LEARN_ONLY@.
    --
    -- By default, Amazon Kendra enables query suggestions. @LEARN_ONLY@ mode
    -- allows you to turn off query suggestions. You can to update this at any
    -- time.
    --
    -- In @LEARN_ONLY@ mode, Amazon Kendra continues to learn from new queries
    -- to keep suggestions up to date for when you are ready to switch to
    -- ENABLED mode again.
    UpdateQuerySuggestionsConfig -> Maybe Mode
mode :: Prelude.Maybe Mode,
    -- | How recent your queries are in your query log time window.
    --
    -- The time window is the number of days from current day to past days.
    --
    -- By default, Amazon Kendra sets this to 180.
    UpdateQuerySuggestionsConfig -> Maybe Int
queryLogLookBackWindowInDays :: Prelude.Maybe Prelude.Int,
    -- | The identifier of the index with query suggestions you want to update.
    UpdateQuerySuggestionsConfig -> Text
indexId :: Prelude.Text
  }
  deriving (UpdateQuerySuggestionsConfig
-> UpdateQuerySuggestionsConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateQuerySuggestionsConfig
-> UpdateQuerySuggestionsConfig -> Bool
$c/= :: UpdateQuerySuggestionsConfig
-> UpdateQuerySuggestionsConfig -> Bool
== :: UpdateQuerySuggestionsConfig
-> UpdateQuerySuggestionsConfig -> Bool
$c== :: UpdateQuerySuggestionsConfig
-> UpdateQuerySuggestionsConfig -> Bool
Prelude.Eq, ReadPrec [UpdateQuerySuggestionsConfig]
ReadPrec UpdateQuerySuggestionsConfig
Int -> ReadS UpdateQuerySuggestionsConfig
ReadS [UpdateQuerySuggestionsConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateQuerySuggestionsConfig]
$creadListPrec :: ReadPrec [UpdateQuerySuggestionsConfig]
readPrec :: ReadPrec UpdateQuerySuggestionsConfig
$creadPrec :: ReadPrec UpdateQuerySuggestionsConfig
readList :: ReadS [UpdateQuerySuggestionsConfig]
$creadList :: ReadS [UpdateQuerySuggestionsConfig]
readsPrec :: Int -> ReadS UpdateQuerySuggestionsConfig
$creadsPrec :: Int -> ReadS UpdateQuerySuggestionsConfig
Prelude.Read, Int -> UpdateQuerySuggestionsConfig -> ShowS
[UpdateQuerySuggestionsConfig] -> ShowS
UpdateQuerySuggestionsConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateQuerySuggestionsConfig] -> ShowS
$cshowList :: [UpdateQuerySuggestionsConfig] -> ShowS
show :: UpdateQuerySuggestionsConfig -> String
$cshow :: UpdateQuerySuggestionsConfig -> String
showsPrec :: Int -> UpdateQuerySuggestionsConfig -> ShowS
$cshowsPrec :: Int -> UpdateQuerySuggestionsConfig -> ShowS
Prelude.Show, forall x.
Rep UpdateQuerySuggestionsConfig x -> UpdateQuerySuggestionsConfig
forall x.
UpdateQuerySuggestionsConfig -> Rep UpdateQuerySuggestionsConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateQuerySuggestionsConfig x -> UpdateQuerySuggestionsConfig
$cfrom :: forall x.
UpdateQuerySuggestionsConfig -> Rep UpdateQuerySuggestionsConfig x
Prelude.Generic)

-- |
-- Create a value of 'UpdateQuerySuggestionsConfig' 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:
--
-- 'includeQueriesWithoutUserInformation', 'updateQuerySuggestionsConfig_includeQueriesWithoutUserInformation' - @TRUE@ to include queries without user information (i.e. all queries,
-- irrespective of the user), otherwise @FALSE@ to only include queries
-- with user information.
--
-- If you pass user information to Amazon Kendra along with the queries,
-- you can set this flag to @FALSE@ and instruct Amazon Kendra to only
-- consider queries with user information.
--
-- If you set to @FALSE@, Amazon Kendra only considers queries searched at
-- least @MinimumQueryCount@ times across @MinimumNumberOfQueryingUsers@
-- unique users for suggestions.
--
-- If you set to @TRUE@, Amazon Kendra ignores all user information and
-- learns from all queries.
--
-- 'minimumNumberOfQueryingUsers', 'updateQuerySuggestionsConfig_minimumNumberOfQueryingUsers' - The minimum number of unique users who must search a query in order for
-- the query to be eligible to suggest to your users.
--
-- Increasing this number might decrease the number of suggestions.
-- However, this ensures a query is searched by many users and is truly
-- popular to suggest to users.
--
-- How you tune this setting depends on your specific needs.
--
-- 'minimumQueryCount', 'updateQuerySuggestionsConfig_minimumQueryCount' - The the minimum number of times a query must be searched in order to be
-- eligible to suggest to your users.
--
-- Decreasing this number increases the number of suggestions. However,
-- this affects the quality of suggestions as it sets a low bar for a query
-- to be considered popular to suggest to users.
--
-- How you tune this setting depends on your specific needs.
--
-- 'mode', 'updateQuerySuggestionsConfig_mode' - Set the mode to @ENABLED@ or @LEARN_ONLY@.
--
-- By default, Amazon Kendra enables query suggestions. @LEARN_ONLY@ mode
-- allows you to turn off query suggestions. You can to update this at any
-- time.
--
-- In @LEARN_ONLY@ mode, Amazon Kendra continues to learn from new queries
-- to keep suggestions up to date for when you are ready to switch to
-- ENABLED mode again.
--
-- 'queryLogLookBackWindowInDays', 'updateQuerySuggestionsConfig_queryLogLookBackWindowInDays' - How recent your queries are in your query log time window.
--
-- The time window is the number of days from current day to past days.
--
-- By default, Amazon Kendra sets this to 180.
--
-- 'indexId', 'updateQuerySuggestionsConfig_indexId' - The identifier of the index with query suggestions you want to update.
newUpdateQuerySuggestionsConfig ::
  -- | 'indexId'
  Prelude.Text ->
  UpdateQuerySuggestionsConfig
newUpdateQuerySuggestionsConfig :: Text -> UpdateQuerySuggestionsConfig
newUpdateQuerySuggestionsConfig Text
pIndexId_ =
  UpdateQuerySuggestionsConfig'
    { $sel:includeQueriesWithoutUserInformation:UpdateQuerySuggestionsConfig' :: Maybe Bool
includeQueriesWithoutUserInformation =
        forall a. Maybe a
Prelude.Nothing,
      $sel:minimumNumberOfQueryingUsers:UpdateQuerySuggestionsConfig' :: Maybe Natural
minimumNumberOfQueryingUsers =
        forall a. Maybe a
Prelude.Nothing,
      $sel:minimumQueryCount:UpdateQuerySuggestionsConfig' :: Maybe Natural
minimumQueryCount = forall a. Maybe a
Prelude.Nothing,
      $sel:mode:UpdateQuerySuggestionsConfig' :: Maybe Mode
mode = forall a. Maybe a
Prelude.Nothing,
      $sel:queryLogLookBackWindowInDays:UpdateQuerySuggestionsConfig' :: Maybe Int
queryLogLookBackWindowInDays =
        forall a. Maybe a
Prelude.Nothing,
      $sel:indexId:UpdateQuerySuggestionsConfig' :: Text
indexId = Text
pIndexId_
    }

-- | @TRUE@ to include queries without user information (i.e. all queries,
-- irrespective of the user), otherwise @FALSE@ to only include queries
-- with user information.
--
-- If you pass user information to Amazon Kendra along with the queries,
-- you can set this flag to @FALSE@ and instruct Amazon Kendra to only
-- consider queries with user information.
--
-- If you set to @FALSE@, Amazon Kendra only considers queries searched at
-- least @MinimumQueryCount@ times across @MinimumNumberOfQueryingUsers@
-- unique users for suggestions.
--
-- If you set to @TRUE@, Amazon Kendra ignores all user information and
-- learns from all queries.
updateQuerySuggestionsConfig_includeQueriesWithoutUserInformation :: Lens.Lens' UpdateQuerySuggestionsConfig (Prelude.Maybe Prelude.Bool)
updateQuerySuggestionsConfig_includeQueriesWithoutUserInformation :: Lens' UpdateQuerySuggestionsConfig (Maybe Bool)
updateQuerySuggestionsConfig_includeQueriesWithoutUserInformation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateQuerySuggestionsConfig' {Maybe Bool
includeQueriesWithoutUserInformation :: Maybe Bool
$sel:includeQueriesWithoutUserInformation:UpdateQuerySuggestionsConfig' :: UpdateQuerySuggestionsConfig -> Maybe Bool
includeQueriesWithoutUserInformation} -> Maybe Bool
includeQueriesWithoutUserInformation) (\s :: UpdateQuerySuggestionsConfig
s@UpdateQuerySuggestionsConfig' {} Maybe Bool
a -> UpdateQuerySuggestionsConfig
s {$sel:includeQueriesWithoutUserInformation:UpdateQuerySuggestionsConfig' :: Maybe Bool
includeQueriesWithoutUserInformation = Maybe Bool
a} :: UpdateQuerySuggestionsConfig)

-- | The minimum number of unique users who must search a query in order for
-- the query to be eligible to suggest to your users.
--
-- Increasing this number might decrease the number of suggestions.
-- However, this ensures a query is searched by many users and is truly
-- popular to suggest to users.
--
-- How you tune this setting depends on your specific needs.
updateQuerySuggestionsConfig_minimumNumberOfQueryingUsers :: Lens.Lens' UpdateQuerySuggestionsConfig (Prelude.Maybe Prelude.Natural)
updateQuerySuggestionsConfig_minimumNumberOfQueryingUsers :: Lens' UpdateQuerySuggestionsConfig (Maybe Natural)
updateQuerySuggestionsConfig_minimumNumberOfQueryingUsers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateQuerySuggestionsConfig' {Maybe Natural
minimumNumberOfQueryingUsers :: Maybe Natural
$sel:minimumNumberOfQueryingUsers:UpdateQuerySuggestionsConfig' :: UpdateQuerySuggestionsConfig -> Maybe Natural
minimumNumberOfQueryingUsers} -> Maybe Natural
minimumNumberOfQueryingUsers) (\s :: UpdateQuerySuggestionsConfig
s@UpdateQuerySuggestionsConfig' {} Maybe Natural
a -> UpdateQuerySuggestionsConfig
s {$sel:minimumNumberOfQueryingUsers:UpdateQuerySuggestionsConfig' :: Maybe Natural
minimumNumberOfQueryingUsers = Maybe Natural
a} :: UpdateQuerySuggestionsConfig)

-- | The the minimum number of times a query must be searched in order to be
-- eligible to suggest to your users.
--
-- Decreasing this number increases the number of suggestions. However,
-- this affects the quality of suggestions as it sets a low bar for a query
-- to be considered popular to suggest to users.
--
-- How you tune this setting depends on your specific needs.
updateQuerySuggestionsConfig_minimumQueryCount :: Lens.Lens' UpdateQuerySuggestionsConfig (Prelude.Maybe Prelude.Natural)
updateQuerySuggestionsConfig_minimumQueryCount :: Lens' UpdateQuerySuggestionsConfig (Maybe Natural)
updateQuerySuggestionsConfig_minimumQueryCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateQuerySuggestionsConfig' {Maybe Natural
minimumQueryCount :: Maybe Natural
$sel:minimumQueryCount:UpdateQuerySuggestionsConfig' :: UpdateQuerySuggestionsConfig -> Maybe Natural
minimumQueryCount} -> Maybe Natural
minimumQueryCount) (\s :: UpdateQuerySuggestionsConfig
s@UpdateQuerySuggestionsConfig' {} Maybe Natural
a -> UpdateQuerySuggestionsConfig
s {$sel:minimumQueryCount:UpdateQuerySuggestionsConfig' :: Maybe Natural
minimumQueryCount = Maybe Natural
a} :: UpdateQuerySuggestionsConfig)

-- | Set the mode to @ENABLED@ or @LEARN_ONLY@.
--
-- By default, Amazon Kendra enables query suggestions. @LEARN_ONLY@ mode
-- allows you to turn off query suggestions. You can to update this at any
-- time.
--
-- In @LEARN_ONLY@ mode, Amazon Kendra continues to learn from new queries
-- to keep suggestions up to date for when you are ready to switch to
-- ENABLED mode again.
updateQuerySuggestionsConfig_mode :: Lens.Lens' UpdateQuerySuggestionsConfig (Prelude.Maybe Mode)
updateQuerySuggestionsConfig_mode :: Lens' UpdateQuerySuggestionsConfig (Maybe Mode)
updateQuerySuggestionsConfig_mode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateQuerySuggestionsConfig' {Maybe Mode
mode :: Maybe Mode
$sel:mode:UpdateQuerySuggestionsConfig' :: UpdateQuerySuggestionsConfig -> Maybe Mode
mode} -> Maybe Mode
mode) (\s :: UpdateQuerySuggestionsConfig
s@UpdateQuerySuggestionsConfig' {} Maybe Mode
a -> UpdateQuerySuggestionsConfig
s {$sel:mode:UpdateQuerySuggestionsConfig' :: Maybe Mode
mode = Maybe Mode
a} :: UpdateQuerySuggestionsConfig)

-- | How recent your queries are in your query log time window.
--
-- The time window is the number of days from current day to past days.
--
-- By default, Amazon Kendra sets this to 180.
updateQuerySuggestionsConfig_queryLogLookBackWindowInDays :: Lens.Lens' UpdateQuerySuggestionsConfig (Prelude.Maybe Prelude.Int)
updateQuerySuggestionsConfig_queryLogLookBackWindowInDays :: Lens' UpdateQuerySuggestionsConfig (Maybe Int)
updateQuerySuggestionsConfig_queryLogLookBackWindowInDays = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateQuerySuggestionsConfig' {Maybe Int
queryLogLookBackWindowInDays :: Maybe Int
$sel:queryLogLookBackWindowInDays:UpdateQuerySuggestionsConfig' :: UpdateQuerySuggestionsConfig -> Maybe Int
queryLogLookBackWindowInDays} -> Maybe Int
queryLogLookBackWindowInDays) (\s :: UpdateQuerySuggestionsConfig
s@UpdateQuerySuggestionsConfig' {} Maybe Int
a -> UpdateQuerySuggestionsConfig
s {$sel:queryLogLookBackWindowInDays:UpdateQuerySuggestionsConfig' :: Maybe Int
queryLogLookBackWindowInDays = Maybe Int
a} :: UpdateQuerySuggestionsConfig)

-- | The identifier of the index with query suggestions you want to update.
updateQuerySuggestionsConfig_indexId :: Lens.Lens' UpdateQuerySuggestionsConfig Prelude.Text
updateQuerySuggestionsConfig_indexId :: Lens' UpdateQuerySuggestionsConfig Text
updateQuerySuggestionsConfig_indexId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateQuerySuggestionsConfig' {Text
indexId :: Text
$sel:indexId:UpdateQuerySuggestionsConfig' :: UpdateQuerySuggestionsConfig -> Text
indexId} -> Text
indexId) (\s :: UpdateQuerySuggestionsConfig
s@UpdateQuerySuggestionsConfig' {} Text
a -> UpdateQuerySuggestionsConfig
s {$sel:indexId:UpdateQuerySuggestionsConfig' :: Text
indexId = Text
a} :: UpdateQuerySuggestionsConfig)

instance Core.AWSRequest UpdateQuerySuggestionsConfig where
  type
    AWSResponse UpdateQuerySuggestionsConfig =
      UpdateQuerySuggestionsConfigResponse
  request :: (Service -> Service)
-> UpdateQuerySuggestionsConfig
-> Request UpdateQuerySuggestionsConfig
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 UpdateQuerySuggestionsConfig
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateQuerySuggestionsConfig)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      UpdateQuerySuggestionsConfigResponse
UpdateQuerySuggestionsConfigResponse'

instance
  Prelude.Hashable
    UpdateQuerySuggestionsConfig
  where
  hashWithSalt :: Int -> UpdateQuerySuggestionsConfig -> Int
hashWithSalt Int
_salt UpdateQuerySuggestionsConfig' {Maybe Bool
Maybe Int
Maybe Natural
Maybe Mode
Text
indexId :: Text
queryLogLookBackWindowInDays :: Maybe Int
mode :: Maybe Mode
minimumQueryCount :: Maybe Natural
minimumNumberOfQueryingUsers :: Maybe Natural
includeQueriesWithoutUserInformation :: Maybe Bool
$sel:indexId:UpdateQuerySuggestionsConfig' :: UpdateQuerySuggestionsConfig -> Text
$sel:queryLogLookBackWindowInDays:UpdateQuerySuggestionsConfig' :: UpdateQuerySuggestionsConfig -> Maybe Int
$sel:mode:UpdateQuerySuggestionsConfig' :: UpdateQuerySuggestionsConfig -> Maybe Mode
$sel:minimumQueryCount:UpdateQuerySuggestionsConfig' :: UpdateQuerySuggestionsConfig -> Maybe Natural
$sel:minimumNumberOfQueryingUsers:UpdateQuerySuggestionsConfig' :: UpdateQuerySuggestionsConfig -> Maybe Natural
$sel:includeQueriesWithoutUserInformation:UpdateQuerySuggestionsConfig' :: UpdateQuerySuggestionsConfig -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
includeQueriesWithoutUserInformation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
minimumNumberOfQueryingUsers
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
minimumQueryCount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Mode
mode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
queryLogLookBackWindowInDays
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
indexId

instance Prelude.NFData UpdateQuerySuggestionsConfig where
  rnf :: UpdateQuerySuggestionsConfig -> ()
rnf UpdateQuerySuggestionsConfig' {Maybe Bool
Maybe Int
Maybe Natural
Maybe Mode
Text
indexId :: Text
queryLogLookBackWindowInDays :: Maybe Int
mode :: Maybe Mode
minimumQueryCount :: Maybe Natural
minimumNumberOfQueryingUsers :: Maybe Natural
includeQueriesWithoutUserInformation :: Maybe Bool
$sel:indexId:UpdateQuerySuggestionsConfig' :: UpdateQuerySuggestionsConfig -> Text
$sel:queryLogLookBackWindowInDays:UpdateQuerySuggestionsConfig' :: UpdateQuerySuggestionsConfig -> Maybe Int
$sel:mode:UpdateQuerySuggestionsConfig' :: UpdateQuerySuggestionsConfig -> Maybe Mode
$sel:minimumQueryCount:UpdateQuerySuggestionsConfig' :: UpdateQuerySuggestionsConfig -> Maybe Natural
$sel:minimumNumberOfQueryingUsers:UpdateQuerySuggestionsConfig' :: UpdateQuerySuggestionsConfig -> Maybe Natural
$sel:includeQueriesWithoutUserInformation:UpdateQuerySuggestionsConfig' :: UpdateQuerySuggestionsConfig -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
includeQueriesWithoutUserInformation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
minimumNumberOfQueryingUsers
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
minimumQueryCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Mode
mode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
queryLogLookBackWindowInDays
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
indexId

instance Data.ToHeaders UpdateQuerySuggestionsConfig where
  toHeaders :: UpdateQuerySuggestionsConfig -> [Header]
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 -> [Header]
Data.=# ( ByteString
"AWSKendraFrontendService.UpdateQuerySuggestionsConfig" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateQuerySuggestionsConfig where
  toJSON :: UpdateQuerySuggestionsConfig -> Value
toJSON UpdateQuerySuggestionsConfig' {Maybe Bool
Maybe Int
Maybe Natural
Maybe Mode
Text
indexId :: Text
queryLogLookBackWindowInDays :: Maybe Int
mode :: Maybe Mode
minimumQueryCount :: Maybe Natural
minimumNumberOfQueryingUsers :: Maybe Natural
includeQueriesWithoutUserInformation :: Maybe Bool
$sel:indexId:UpdateQuerySuggestionsConfig' :: UpdateQuerySuggestionsConfig -> Text
$sel:queryLogLookBackWindowInDays:UpdateQuerySuggestionsConfig' :: UpdateQuerySuggestionsConfig -> Maybe Int
$sel:mode:UpdateQuerySuggestionsConfig' :: UpdateQuerySuggestionsConfig -> Maybe Mode
$sel:minimumQueryCount:UpdateQuerySuggestionsConfig' :: UpdateQuerySuggestionsConfig -> Maybe Natural
$sel:minimumNumberOfQueryingUsers:UpdateQuerySuggestionsConfig' :: UpdateQuerySuggestionsConfig -> Maybe Natural
$sel:includeQueriesWithoutUserInformation:UpdateQuerySuggestionsConfig' :: UpdateQuerySuggestionsConfig -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"IncludeQueriesWithoutUserInformation" 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 Bool
includeQueriesWithoutUserInformation,
            (Key
"MinimumNumberOfQueryingUsers" 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
minimumNumberOfQueryingUsers,
            (Key
"MinimumQueryCount" 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
minimumQueryCount,
            (Key
"Mode" 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 Mode
mode,
            (Key
"QueryLogLookBackWindowInDays" 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
queryLogLookBackWindowInDays,
            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 UpdateQuerySuggestionsConfig where
  toPath :: UpdateQuerySuggestionsConfig -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newUpdateQuerySuggestionsConfigResponse' smart constructor.
data UpdateQuerySuggestionsConfigResponse = UpdateQuerySuggestionsConfigResponse'
  {
  }
  deriving (UpdateQuerySuggestionsConfigResponse
-> UpdateQuerySuggestionsConfigResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateQuerySuggestionsConfigResponse
-> UpdateQuerySuggestionsConfigResponse -> Bool
$c/= :: UpdateQuerySuggestionsConfigResponse
-> UpdateQuerySuggestionsConfigResponse -> Bool
== :: UpdateQuerySuggestionsConfigResponse
-> UpdateQuerySuggestionsConfigResponse -> Bool
$c== :: UpdateQuerySuggestionsConfigResponse
-> UpdateQuerySuggestionsConfigResponse -> Bool
Prelude.Eq, ReadPrec [UpdateQuerySuggestionsConfigResponse]
ReadPrec UpdateQuerySuggestionsConfigResponse
Int -> ReadS UpdateQuerySuggestionsConfigResponse
ReadS [UpdateQuerySuggestionsConfigResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateQuerySuggestionsConfigResponse]
$creadListPrec :: ReadPrec [UpdateQuerySuggestionsConfigResponse]
readPrec :: ReadPrec UpdateQuerySuggestionsConfigResponse
$creadPrec :: ReadPrec UpdateQuerySuggestionsConfigResponse
readList :: ReadS [UpdateQuerySuggestionsConfigResponse]
$creadList :: ReadS [UpdateQuerySuggestionsConfigResponse]
readsPrec :: Int -> ReadS UpdateQuerySuggestionsConfigResponse
$creadsPrec :: Int -> ReadS UpdateQuerySuggestionsConfigResponse
Prelude.Read, Int -> UpdateQuerySuggestionsConfigResponse -> ShowS
[UpdateQuerySuggestionsConfigResponse] -> ShowS
UpdateQuerySuggestionsConfigResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateQuerySuggestionsConfigResponse] -> ShowS
$cshowList :: [UpdateQuerySuggestionsConfigResponse] -> ShowS
show :: UpdateQuerySuggestionsConfigResponse -> String
$cshow :: UpdateQuerySuggestionsConfigResponse -> String
showsPrec :: Int -> UpdateQuerySuggestionsConfigResponse -> ShowS
$cshowsPrec :: Int -> UpdateQuerySuggestionsConfigResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateQuerySuggestionsConfigResponse x
-> UpdateQuerySuggestionsConfigResponse
forall x.
UpdateQuerySuggestionsConfigResponse
-> Rep UpdateQuerySuggestionsConfigResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateQuerySuggestionsConfigResponse x
-> UpdateQuerySuggestionsConfigResponse
$cfrom :: forall x.
UpdateQuerySuggestionsConfigResponse
-> Rep UpdateQuerySuggestionsConfigResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateQuerySuggestionsConfigResponse' 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.
newUpdateQuerySuggestionsConfigResponse ::
  UpdateQuerySuggestionsConfigResponse
newUpdateQuerySuggestionsConfigResponse :: UpdateQuerySuggestionsConfigResponse
newUpdateQuerySuggestionsConfigResponse =
  UpdateQuerySuggestionsConfigResponse
UpdateQuerySuggestionsConfigResponse'

instance
  Prelude.NFData
    UpdateQuerySuggestionsConfigResponse
  where
  rnf :: UpdateQuerySuggestionsConfigResponse -> ()
rnf UpdateQuerySuggestionsConfigResponse
_ = ()