{-# 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.UpdateQuerySuggestionsBlockList
-- 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 a block list used for query suggestions for an index.
--
-- Updates to a block list might not take effect right away. Amazon Kendra
-- needs to refresh the entire suggestions list to apply any updates to the
-- block list. Other changes not related to the block list apply
-- immediately.
--
-- If a block list is updating, then you need to wait for the first update
-- to finish before submitting another update.
--
-- Amazon Kendra supports partial updates, so you only need to provide the
-- fields you want to update.
--
-- @UpdateQuerySuggestionsBlockList@ is currently not supported in the
-- Amazon Web Services GovCloud (US-West) region.
module Amazonka.Kendra.UpdateQuerySuggestionsBlockList
  ( -- * Creating a Request
    UpdateQuerySuggestionsBlockList (..),
    newUpdateQuerySuggestionsBlockList,

    -- * Request Lenses
    updateQuerySuggestionsBlockList_description,
    updateQuerySuggestionsBlockList_name,
    updateQuerySuggestionsBlockList_roleArn,
    updateQuerySuggestionsBlockList_sourceS3Path,
    updateQuerySuggestionsBlockList_indexId,
    updateQuerySuggestionsBlockList_id,

    -- * Destructuring the Response
    UpdateQuerySuggestionsBlockListResponse (..),
    newUpdateQuerySuggestionsBlockListResponse,
  )
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:/ 'newUpdateQuerySuggestionsBlockList' smart constructor.
data UpdateQuerySuggestionsBlockList = UpdateQuerySuggestionsBlockList'
  { -- | A new description for the block list.
    UpdateQuerySuggestionsBlockList -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | A new name for the block list.
    UpdateQuerySuggestionsBlockList -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The IAM (Identity and Access Management) role used to access the block
    -- list text file in S3.
    UpdateQuerySuggestionsBlockList -> Maybe Text
roleArn :: Prelude.Maybe Prelude.Text,
    -- | The S3 path where your block list text file sits in S3.
    --
    -- If you update your block list and provide the same path to the block
    -- list text file in S3, then Amazon Kendra reloads the file to refresh the
    -- block list. Amazon Kendra does not automatically refresh your block
    -- list. You need to call the @UpdateQuerySuggestionsBlockList@ API to
    -- refresh you block list.
    --
    -- If you update your block list, then Amazon Kendra asynchronously
    -- refreshes all query suggestions with the latest content in the S3 file.
    -- This means changes might not take effect immediately.
    UpdateQuerySuggestionsBlockList -> Maybe S3Path
sourceS3Path :: Prelude.Maybe S3Path,
    -- | The identifier of the index for the block list.
    UpdateQuerySuggestionsBlockList -> Text
indexId :: Prelude.Text,
    -- | The identifier of the block list you want to update.
    UpdateQuerySuggestionsBlockList -> Text
id :: Prelude.Text
  }
  deriving (UpdateQuerySuggestionsBlockList
-> UpdateQuerySuggestionsBlockList -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateQuerySuggestionsBlockList
-> UpdateQuerySuggestionsBlockList -> Bool
$c/= :: UpdateQuerySuggestionsBlockList
-> UpdateQuerySuggestionsBlockList -> Bool
== :: UpdateQuerySuggestionsBlockList
-> UpdateQuerySuggestionsBlockList -> Bool
$c== :: UpdateQuerySuggestionsBlockList
-> UpdateQuerySuggestionsBlockList -> Bool
Prelude.Eq, ReadPrec [UpdateQuerySuggestionsBlockList]
ReadPrec UpdateQuerySuggestionsBlockList
Int -> ReadS UpdateQuerySuggestionsBlockList
ReadS [UpdateQuerySuggestionsBlockList]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateQuerySuggestionsBlockList]
$creadListPrec :: ReadPrec [UpdateQuerySuggestionsBlockList]
readPrec :: ReadPrec UpdateQuerySuggestionsBlockList
$creadPrec :: ReadPrec UpdateQuerySuggestionsBlockList
readList :: ReadS [UpdateQuerySuggestionsBlockList]
$creadList :: ReadS [UpdateQuerySuggestionsBlockList]
readsPrec :: Int -> ReadS UpdateQuerySuggestionsBlockList
$creadsPrec :: Int -> ReadS UpdateQuerySuggestionsBlockList
Prelude.Read, Int -> UpdateQuerySuggestionsBlockList -> ShowS
[UpdateQuerySuggestionsBlockList] -> ShowS
UpdateQuerySuggestionsBlockList -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateQuerySuggestionsBlockList] -> ShowS
$cshowList :: [UpdateQuerySuggestionsBlockList] -> ShowS
show :: UpdateQuerySuggestionsBlockList -> String
$cshow :: UpdateQuerySuggestionsBlockList -> String
showsPrec :: Int -> UpdateQuerySuggestionsBlockList -> ShowS
$cshowsPrec :: Int -> UpdateQuerySuggestionsBlockList -> ShowS
Prelude.Show, forall x.
Rep UpdateQuerySuggestionsBlockList x
-> UpdateQuerySuggestionsBlockList
forall x.
UpdateQuerySuggestionsBlockList
-> Rep UpdateQuerySuggestionsBlockList x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateQuerySuggestionsBlockList x
-> UpdateQuerySuggestionsBlockList
$cfrom :: forall x.
UpdateQuerySuggestionsBlockList
-> Rep UpdateQuerySuggestionsBlockList x
Prelude.Generic)

-- |
-- Create a value of 'UpdateQuerySuggestionsBlockList' 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:
--
-- 'description', 'updateQuerySuggestionsBlockList_description' - A new description for the block list.
--
-- 'name', 'updateQuerySuggestionsBlockList_name' - A new name for the block list.
--
-- 'roleArn', 'updateQuerySuggestionsBlockList_roleArn' - The IAM (Identity and Access Management) role used to access the block
-- list text file in S3.
--
-- 'sourceS3Path', 'updateQuerySuggestionsBlockList_sourceS3Path' - The S3 path where your block list text file sits in S3.
--
-- If you update your block list and provide the same path to the block
-- list text file in S3, then Amazon Kendra reloads the file to refresh the
-- block list. Amazon Kendra does not automatically refresh your block
-- list. You need to call the @UpdateQuerySuggestionsBlockList@ API to
-- refresh you block list.
--
-- If you update your block list, then Amazon Kendra asynchronously
-- refreshes all query suggestions with the latest content in the S3 file.
-- This means changes might not take effect immediately.
--
-- 'indexId', 'updateQuerySuggestionsBlockList_indexId' - The identifier of the index for the block list.
--
-- 'id', 'updateQuerySuggestionsBlockList_id' - The identifier of the block list you want to update.
newUpdateQuerySuggestionsBlockList ::
  -- | 'indexId'
  Prelude.Text ->
  -- | 'id'
  Prelude.Text ->
  UpdateQuerySuggestionsBlockList
newUpdateQuerySuggestionsBlockList :: Text -> Text -> UpdateQuerySuggestionsBlockList
newUpdateQuerySuggestionsBlockList Text
pIndexId_ Text
pId_ =
  UpdateQuerySuggestionsBlockList'
    { $sel:description:UpdateQuerySuggestionsBlockList' :: Maybe Text
description =
        forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateQuerySuggestionsBlockList' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:roleArn:UpdateQuerySuggestionsBlockList' :: Maybe Text
roleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceS3Path:UpdateQuerySuggestionsBlockList' :: Maybe S3Path
sourceS3Path = forall a. Maybe a
Prelude.Nothing,
      $sel:indexId:UpdateQuerySuggestionsBlockList' :: Text
indexId = Text
pIndexId_,
      $sel:id:UpdateQuerySuggestionsBlockList' :: Text
id = Text
pId_
    }

-- | A new description for the block list.
updateQuerySuggestionsBlockList_description :: Lens.Lens' UpdateQuerySuggestionsBlockList (Prelude.Maybe Prelude.Text)
updateQuerySuggestionsBlockList_description :: Lens' UpdateQuerySuggestionsBlockList (Maybe Text)
updateQuerySuggestionsBlockList_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateQuerySuggestionsBlockList' {Maybe Text
description :: Maybe Text
$sel:description:UpdateQuerySuggestionsBlockList' :: UpdateQuerySuggestionsBlockList -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateQuerySuggestionsBlockList
s@UpdateQuerySuggestionsBlockList' {} Maybe Text
a -> UpdateQuerySuggestionsBlockList
s {$sel:description:UpdateQuerySuggestionsBlockList' :: Maybe Text
description = Maybe Text
a} :: UpdateQuerySuggestionsBlockList)

-- | A new name for the block list.
updateQuerySuggestionsBlockList_name :: Lens.Lens' UpdateQuerySuggestionsBlockList (Prelude.Maybe Prelude.Text)
updateQuerySuggestionsBlockList_name :: Lens' UpdateQuerySuggestionsBlockList (Maybe Text)
updateQuerySuggestionsBlockList_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateQuerySuggestionsBlockList' {Maybe Text
name :: Maybe Text
$sel:name:UpdateQuerySuggestionsBlockList' :: UpdateQuerySuggestionsBlockList -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdateQuerySuggestionsBlockList
s@UpdateQuerySuggestionsBlockList' {} Maybe Text
a -> UpdateQuerySuggestionsBlockList
s {$sel:name:UpdateQuerySuggestionsBlockList' :: Maybe Text
name = Maybe Text
a} :: UpdateQuerySuggestionsBlockList)

-- | The IAM (Identity and Access Management) role used to access the block
-- list text file in S3.
updateQuerySuggestionsBlockList_roleArn :: Lens.Lens' UpdateQuerySuggestionsBlockList (Prelude.Maybe Prelude.Text)
updateQuerySuggestionsBlockList_roleArn :: Lens' UpdateQuerySuggestionsBlockList (Maybe Text)
updateQuerySuggestionsBlockList_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateQuerySuggestionsBlockList' {Maybe Text
roleArn :: Maybe Text
$sel:roleArn:UpdateQuerySuggestionsBlockList' :: UpdateQuerySuggestionsBlockList -> Maybe Text
roleArn} -> Maybe Text
roleArn) (\s :: UpdateQuerySuggestionsBlockList
s@UpdateQuerySuggestionsBlockList' {} Maybe Text
a -> UpdateQuerySuggestionsBlockList
s {$sel:roleArn:UpdateQuerySuggestionsBlockList' :: Maybe Text
roleArn = Maybe Text
a} :: UpdateQuerySuggestionsBlockList)

-- | The S3 path where your block list text file sits in S3.
--
-- If you update your block list and provide the same path to the block
-- list text file in S3, then Amazon Kendra reloads the file to refresh the
-- block list. Amazon Kendra does not automatically refresh your block
-- list. You need to call the @UpdateQuerySuggestionsBlockList@ API to
-- refresh you block list.
--
-- If you update your block list, then Amazon Kendra asynchronously
-- refreshes all query suggestions with the latest content in the S3 file.
-- This means changes might not take effect immediately.
updateQuerySuggestionsBlockList_sourceS3Path :: Lens.Lens' UpdateQuerySuggestionsBlockList (Prelude.Maybe S3Path)
updateQuerySuggestionsBlockList_sourceS3Path :: Lens' UpdateQuerySuggestionsBlockList (Maybe S3Path)
updateQuerySuggestionsBlockList_sourceS3Path = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateQuerySuggestionsBlockList' {Maybe S3Path
sourceS3Path :: Maybe S3Path
$sel:sourceS3Path:UpdateQuerySuggestionsBlockList' :: UpdateQuerySuggestionsBlockList -> Maybe S3Path
sourceS3Path} -> Maybe S3Path
sourceS3Path) (\s :: UpdateQuerySuggestionsBlockList
s@UpdateQuerySuggestionsBlockList' {} Maybe S3Path
a -> UpdateQuerySuggestionsBlockList
s {$sel:sourceS3Path:UpdateQuerySuggestionsBlockList' :: Maybe S3Path
sourceS3Path = Maybe S3Path
a} :: UpdateQuerySuggestionsBlockList)

-- | The identifier of the index for the block list.
updateQuerySuggestionsBlockList_indexId :: Lens.Lens' UpdateQuerySuggestionsBlockList Prelude.Text
updateQuerySuggestionsBlockList_indexId :: Lens' UpdateQuerySuggestionsBlockList Text
updateQuerySuggestionsBlockList_indexId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateQuerySuggestionsBlockList' {Text
indexId :: Text
$sel:indexId:UpdateQuerySuggestionsBlockList' :: UpdateQuerySuggestionsBlockList -> Text
indexId} -> Text
indexId) (\s :: UpdateQuerySuggestionsBlockList
s@UpdateQuerySuggestionsBlockList' {} Text
a -> UpdateQuerySuggestionsBlockList
s {$sel:indexId:UpdateQuerySuggestionsBlockList' :: Text
indexId = Text
a} :: UpdateQuerySuggestionsBlockList)

-- | The identifier of the block list you want to update.
updateQuerySuggestionsBlockList_id :: Lens.Lens' UpdateQuerySuggestionsBlockList Prelude.Text
updateQuerySuggestionsBlockList_id :: Lens' UpdateQuerySuggestionsBlockList Text
updateQuerySuggestionsBlockList_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateQuerySuggestionsBlockList' {Text
id :: Text
$sel:id:UpdateQuerySuggestionsBlockList' :: UpdateQuerySuggestionsBlockList -> Text
id} -> Text
id) (\s :: UpdateQuerySuggestionsBlockList
s@UpdateQuerySuggestionsBlockList' {} Text
a -> UpdateQuerySuggestionsBlockList
s {$sel:id:UpdateQuerySuggestionsBlockList' :: Text
id = Text
a} :: UpdateQuerySuggestionsBlockList)

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

instance
  Prelude.Hashable
    UpdateQuerySuggestionsBlockList
  where
  hashWithSalt :: Int -> UpdateQuerySuggestionsBlockList -> Int
hashWithSalt
    Int
_salt
    UpdateQuerySuggestionsBlockList' {Maybe Text
Maybe S3Path
Text
id :: Text
indexId :: Text
sourceS3Path :: Maybe S3Path
roleArn :: Maybe Text
name :: Maybe Text
description :: Maybe Text
$sel:id:UpdateQuerySuggestionsBlockList' :: UpdateQuerySuggestionsBlockList -> Text
$sel:indexId:UpdateQuerySuggestionsBlockList' :: UpdateQuerySuggestionsBlockList -> Text
$sel:sourceS3Path:UpdateQuerySuggestionsBlockList' :: UpdateQuerySuggestionsBlockList -> Maybe S3Path
$sel:roleArn:UpdateQuerySuggestionsBlockList' :: UpdateQuerySuggestionsBlockList -> Maybe Text
$sel:name:UpdateQuerySuggestionsBlockList' :: UpdateQuerySuggestionsBlockList -> Maybe Text
$sel:description:UpdateQuerySuggestionsBlockList' :: UpdateQuerySuggestionsBlockList -> Maybe Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
roleArn
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe S3Path
sourceS3Path
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
indexId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id

instance
  Prelude.NFData
    UpdateQuerySuggestionsBlockList
  where
  rnf :: UpdateQuerySuggestionsBlockList -> ()
rnf UpdateQuerySuggestionsBlockList' {Maybe Text
Maybe S3Path
Text
id :: Text
indexId :: Text
sourceS3Path :: Maybe S3Path
roleArn :: Maybe Text
name :: Maybe Text
description :: Maybe Text
$sel:id:UpdateQuerySuggestionsBlockList' :: UpdateQuerySuggestionsBlockList -> Text
$sel:indexId:UpdateQuerySuggestionsBlockList' :: UpdateQuerySuggestionsBlockList -> Text
$sel:sourceS3Path:UpdateQuerySuggestionsBlockList' :: UpdateQuerySuggestionsBlockList -> Maybe S3Path
$sel:roleArn:UpdateQuerySuggestionsBlockList' :: UpdateQuerySuggestionsBlockList -> Maybe Text
$sel:name:UpdateQuerySuggestionsBlockList' :: UpdateQuerySuggestionsBlockList -> Maybe Text
$sel:description:UpdateQuerySuggestionsBlockList' :: UpdateQuerySuggestionsBlockList -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
roleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe S3Path
sourceS3Path
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
indexId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id

instance
  Data.ToHeaders
    UpdateQuerySuggestionsBlockList
  where
  toHeaders :: UpdateQuerySuggestionsBlockList -> [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.UpdateQuerySuggestionsBlockList" ::
                          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 UpdateQuerySuggestionsBlockList where
  toJSON :: UpdateQuerySuggestionsBlockList -> Value
toJSON UpdateQuerySuggestionsBlockList' {Maybe Text
Maybe S3Path
Text
id :: Text
indexId :: Text
sourceS3Path :: Maybe S3Path
roleArn :: Maybe Text
name :: Maybe Text
description :: Maybe Text
$sel:id:UpdateQuerySuggestionsBlockList' :: UpdateQuerySuggestionsBlockList -> Text
$sel:indexId:UpdateQuerySuggestionsBlockList' :: UpdateQuerySuggestionsBlockList -> Text
$sel:sourceS3Path:UpdateQuerySuggestionsBlockList' :: UpdateQuerySuggestionsBlockList -> Maybe S3Path
$sel:roleArn:UpdateQuerySuggestionsBlockList' :: UpdateQuerySuggestionsBlockList -> Maybe Text
$sel:name:UpdateQuerySuggestionsBlockList' :: UpdateQuerySuggestionsBlockList -> Maybe Text
$sel:description:UpdateQuerySuggestionsBlockList' :: UpdateQuerySuggestionsBlockList -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Description" 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
description,
            (Key
"Name" 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
name,
            (Key
"RoleArn" 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
roleArn,
            (Key
"SourceS3Path" 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 S3Path
sourceS3Path,
            forall a. a -> Maybe a
Prelude.Just (Key
"IndexId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
indexId),
            forall a. a -> Maybe a
Prelude.Just (Key
"Id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
id)
          ]
      )

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

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

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

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

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