{-# 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.UpdateIndex
-- 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 an existing Amazon Kendra index.
module Amazonka.Kendra.UpdateIndex
  ( -- * Creating a Request
    UpdateIndex (..),
    newUpdateIndex,

    -- * Request Lenses
    updateIndex_capacityUnits,
    updateIndex_description,
    updateIndex_documentMetadataConfigurationUpdates,
    updateIndex_name,
    updateIndex_roleArn,
    updateIndex_userContextPolicy,
    updateIndex_userGroupResolutionConfiguration,
    updateIndex_userTokenConfigurations,
    updateIndex_id,

    -- * Destructuring the Response
    UpdateIndexResponse (..),
    newUpdateIndexResponse,
  )
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:/ 'newUpdateIndex' smart constructor.
data UpdateIndex = UpdateIndex'
  { -- | Sets the number of additional document storage and query capacity units
    -- that should be used by the index. You can change the capacity of the
    -- index up to 5 times per day, or make 5 API calls.
    --
    -- If you are using extra storage units, you can\'t reduce the storage
    -- capacity below what is required to meet the storage needs for your
    -- index.
    UpdateIndex -> Maybe CapacityUnitsConfiguration
capacityUnits :: Prelude.Maybe CapacityUnitsConfiguration,
    -- | A new description for the index.
    UpdateIndex -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The document metadata configuration you want to update for the index.
    -- Document metadata are fields or attributes associated with your
    -- documents. For example, the company department name associated with each
    -- document.
    UpdateIndex -> Maybe [DocumentMetadataConfiguration]
documentMetadataConfigurationUpdates :: Prelude.Maybe [DocumentMetadataConfiguration],
    -- | The name of the index you want to update.
    UpdateIndex -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | An Identity and Access Management (IAM) role that gives Amazon Kendra
    -- permission to access Amazon CloudWatch logs and metrics.
    UpdateIndex -> Maybe Text
roleArn :: Prelude.Maybe Prelude.Text,
    -- | The user context policy.
    UpdateIndex -> Maybe UserContextPolicy
userContextPolicy :: Prelude.Maybe UserContextPolicy,
    -- | Enables fetching access levels of groups and users from an IAM Identity
    -- Center (successor to Single Sign-On) identity source. To configure this,
    -- see
    -- <https://docs.aws.amazon.com/kendra/latest/dg/API_UserGroupResolutionConfiguration.html UserGroupResolutionConfiguration>.
    UpdateIndex -> Maybe UserGroupResolutionConfiguration
userGroupResolutionConfiguration :: Prelude.Maybe UserGroupResolutionConfiguration,
    -- | The user token configuration.
    UpdateIndex -> Maybe [UserTokenConfiguration]
userTokenConfigurations :: Prelude.Maybe [UserTokenConfiguration],
    -- | The identifier of the index you want to update.
    UpdateIndex -> Text
id :: Prelude.Text
  }
  deriving (UpdateIndex -> UpdateIndex -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateIndex -> UpdateIndex -> Bool
$c/= :: UpdateIndex -> UpdateIndex -> Bool
== :: UpdateIndex -> UpdateIndex -> Bool
$c== :: UpdateIndex -> UpdateIndex -> Bool
Prelude.Eq, ReadPrec [UpdateIndex]
ReadPrec UpdateIndex
Int -> ReadS UpdateIndex
ReadS [UpdateIndex]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateIndex]
$creadListPrec :: ReadPrec [UpdateIndex]
readPrec :: ReadPrec UpdateIndex
$creadPrec :: ReadPrec UpdateIndex
readList :: ReadS [UpdateIndex]
$creadList :: ReadS [UpdateIndex]
readsPrec :: Int -> ReadS UpdateIndex
$creadsPrec :: Int -> ReadS UpdateIndex
Prelude.Read, Int -> UpdateIndex -> ShowS
[UpdateIndex] -> ShowS
UpdateIndex -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateIndex] -> ShowS
$cshowList :: [UpdateIndex] -> ShowS
show :: UpdateIndex -> String
$cshow :: UpdateIndex -> String
showsPrec :: Int -> UpdateIndex -> ShowS
$cshowsPrec :: Int -> UpdateIndex -> ShowS
Prelude.Show, forall x. Rep UpdateIndex x -> UpdateIndex
forall x. UpdateIndex -> Rep UpdateIndex x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateIndex x -> UpdateIndex
$cfrom :: forall x. UpdateIndex -> Rep UpdateIndex x
Prelude.Generic)

-- |
-- Create a value of 'UpdateIndex' 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:
--
-- 'capacityUnits', 'updateIndex_capacityUnits' - Sets the number of additional document storage and query capacity units
-- that should be used by the index. You can change the capacity of the
-- index up to 5 times per day, or make 5 API calls.
--
-- If you are using extra storage units, you can\'t reduce the storage
-- capacity below what is required to meet the storage needs for your
-- index.
--
-- 'description', 'updateIndex_description' - A new description for the index.
--
-- 'documentMetadataConfigurationUpdates', 'updateIndex_documentMetadataConfigurationUpdates' - The document metadata configuration you want to update for the index.
-- Document metadata are fields or attributes associated with your
-- documents. For example, the company department name associated with each
-- document.
--
-- 'name', 'updateIndex_name' - The name of the index you want to update.
--
-- 'roleArn', 'updateIndex_roleArn' - An Identity and Access Management (IAM) role that gives Amazon Kendra
-- permission to access Amazon CloudWatch logs and metrics.
--
-- 'userContextPolicy', 'updateIndex_userContextPolicy' - The user context policy.
--
-- 'userGroupResolutionConfiguration', 'updateIndex_userGroupResolutionConfiguration' - Enables fetching access levels of groups and users from an IAM Identity
-- Center (successor to Single Sign-On) identity source. To configure this,
-- see
-- <https://docs.aws.amazon.com/kendra/latest/dg/API_UserGroupResolutionConfiguration.html UserGroupResolutionConfiguration>.
--
-- 'userTokenConfigurations', 'updateIndex_userTokenConfigurations' - The user token configuration.
--
-- 'id', 'updateIndex_id' - The identifier of the index you want to update.
newUpdateIndex ::
  -- | 'id'
  Prelude.Text ->
  UpdateIndex
newUpdateIndex :: Text -> UpdateIndex
newUpdateIndex Text
pId_ =
  UpdateIndex'
    { $sel:capacityUnits:UpdateIndex' :: Maybe CapacityUnitsConfiguration
capacityUnits = forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdateIndex' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:documentMetadataConfigurationUpdates:UpdateIndex' :: Maybe [DocumentMetadataConfiguration]
documentMetadataConfigurationUpdates =
        forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateIndex' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:roleArn:UpdateIndex' :: Maybe Text
roleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:userContextPolicy:UpdateIndex' :: Maybe UserContextPolicy
userContextPolicy = forall a. Maybe a
Prelude.Nothing,
      $sel:userGroupResolutionConfiguration:UpdateIndex' :: Maybe UserGroupResolutionConfiguration
userGroupResolutionConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:userTokenConfigurations:UpdateIndex' :: Maybe [UserTokenConfiguration]
userTokenConfigurations = forall a. Maybe a
Prelude.Nothing,
      $sel:id:UpdateIndex' :: Text
id = Text
pId_
    }

-- | Sets the number of additional document storage and query capacity units
-- that should be used by the index. You can change the capacity of the
-- index up to 5 times per day, or make 5 API calls.
--
-- If you are using extra storage units, you can\'t reduce the storage
-- capacity below what is required to meet the storage needs for your
-- index.
updateIndex_capacityUnits :: Lens.Lens' UpdateIndex (Prelude.Maybe CapacityUnitsConfiguration)
updateIndex_capacityUnits :: Lens' UpdateIndex (Maybe CapacityUnitsConfiguration)
updateIndex_capacityUnits = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIndex' {Maybe CapacityUnitsConfiguration
capacityUnits :: Maybe CapacityUnitsConfiguration
$sel:capacityUnits:UpdateIndex' :: UpdateIndex -> Maybe CapacityUnitsConfiguration
capacityUnits} -> Maybe CapacityUnitsConfiguration
capacityUnits) (\s :: UpdateIndex
s@UpdateIndex' {} Maybe CapacityUnitsConfiguration
a -> UpdateIndex
s {$sel:capacityUnits:UpdateIndex' :: Maybe CapacityUnitsConfiguration
capacityUnits = Maybe CapacityUnitsConfiguration
a} :: UpdateIndex)

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

-- | The document metadata configuration you want to update for the index.
-- Document metadata are fields or attributes associated with your
-- documents. For example, the company department name associated with each
-- document.
updateIndex_documentMetadataConfigurationUpdates :: Lens.Lens' UpdateIndex (Prelude.Maybe [DocumentMetadataConfiguration])
updateIndex_documentMetadataConfigurationUpdates :: Lens' UpdateIndex (Maybe [DocumentMetadataConfiguration])
updateIndex_documentMetadataConfigurationUpdates = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIndex' {Maybe [DocumentMetadataConfiguration]
documentMetadataConfigurationUpdates :: Maybe [DocumentMetadataConfiguration]
$sel:documentMetadataConfigurationUpdates:UpdateIndex' :: UpdateIndex -> Maybe [DocumentMetadataConfiguration]
documentMetadataConfigurationUpdates} -> Maybe [DocumentMetadataConfiguration]
documentMetadataConfigurationUpdates) (\s :: UpdateIndex
s@UpdateIndex' {} Maybe [DocumentMetadataConfiguration]
a -> UpdateIndex
s {$sel:documentMetadataConfigurationUpdates:UpdateIndex' :: Maybe [DocumentMetadataConfiguration]
documentMetadataConfigurationUpdates = Maybe [DocumentMetadataConfiguration]
a} :: UpdateIndex) 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 name of the index you want to update.
updateIndex_name :: Lens.Lens' UpdateIndex (Prelude.Maybe Prelude.Text)
updateIndex_name :: Lens' UpdateIndex (Maybe Text)
updateIndex_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIndex' {Maybe Text
name :: Maybe Text
$sel:name:UpdateIndex' :: UpdateIndex -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdateIndex
s@UpdateIndex' {} Maybe Text
a -> UpdateIndex
s {$sel:name:UpdateIndex' :: Maybe Text
name = Maybe Text
a} :: UpdateIndex)

-- | An Identity and Access Management (IAM) role that gives Amazon Kendra
-- permission to access Amazon CloudWatch logs and metrics.
updateIndex_roleArn :: Lens.Lens' UpdateIndex (Prelude.Maybe Prelude.Text)
updateIndex_roleArn :: Lens' UpdateIndex (Maybe Text)
updateIndex_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIndex' {Maybe Text
roleArn :: Maybe Text
$sel:roleArn:UpdateIndex' :: UpdateIndex -> Maybe Text
roleArn} -> Maybe Text
roleArn) (\s :: UpdateIndex
s@UpdateIndex' {} Maybe Text
a -> UpdateIndex
s {$sel:roleArn:UpdateIndex' :: Maybe Text
roleArn = Maybe Text
a} :: UpdateIndex)

-- | The user context policy.
updateIndex_userContextPolicy :: Lens.Lens' UpdateIndex (Prelude.Maybe UserContextPolicy)
updateIndex_userContextPolicy :: Lens' UpdateIndex (Maybe UserContextPolicy)
updateIndex_userContextPolicy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIndex' {Maybe UserContextPolicy
userContextPolicy :: Maybe UserContextPolicy
$sel:userContextPolicy:UpdateIndex' :: UpdateIndex -> Maybe UserContextPolicy
userContextPolicy} -> Maybe UserContextPolicy
userContextPolicy) (\s :: UpdateIndex
s@UpdateIndex' {} Maybe UserContextPolicy
a -> UpdateIndex
s {$sel:userContextPolicy:UpdateIndex' :: Maybe UserContextPolicy
userContextPolicy = Maybe UserContextPolicy
a} :: UpdateIndex)

-- | Enables fetching access levels of groups and users from an IAM Identity
-- Center (successor to Single Sign-On) identity source. To configure this,
-- see
-- <https://docs.aws.amazon.com/kendra/latest/dg/API_UserGroupResolutionConfiguration.html UserGroupResolutionConfiguration>.
updateIndex_userGroupResolutionConfiguration :: Lens.Lens' UpdateIndex (Prelude.Maybe UserGroupResolutionConfiguration)
updateIndex_userGroupResolutionConfiguration :: Lens' UpdateIndex (Maybe UserGroupResolutionConfiguration)
updateIndex_userGroupResolutionConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIndex' {Maybe UserGroupResolutionConfiguration
userGroupResolutionConfiguration :: Maybe UserGroupResolutionConfiguration
$sel:userGroupResolutionConfiguration:UpdateIndex' :: UpdateIndex -> Maybe UserGroupResolutionConfiguration
userGroupResolutionConfiguration} -> Maybe UserGroupResolutionConfiguration
userGroupResolutionConfiguration) (\s :: UpdateIndex
s@UpdateIndex' {} Maybe UserGroupResolutionConfiguration
a -> UpdateIndex
s {$sel:userGroupResolutionConfiguration:UpdateIndex' :: Maybe UserGroupResolutionConfiguration
userGroupResolutionConfiguration = Maybe UserGroupResolutionConfiguration
a} :: UpdateIndex)

-- | The user token configuration.
updateIndex_userTokenConfigurations :: Lens.Lens' UpdateIndex (Prelude.Maybe [UserTokenConfiguration])
updateIndex_userTokenConfigurations :: Lens' UpdateIndex (Maybe [UserTokenConfiguration])
updateIndex_userTokenConfigurations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIndex' {Maybe [UserTokenConfiguration]
userTokenConfigurations :: Maybe [UserTokenConfiguration]
$sel:userTokenConfigurations:UpdateIndex' :: UpdateIndex -> Maybe [UserTokenConfiguration]
userTokenConfigurations} -> Maybe [UserTokenConfiguration]
userTokenConfigurations) (\s :: UpdateIndex
s@UpdateIndex' {} Maybe [UserTokenConfiguration]
a -> UpdateIndex
s {$sel:userTokenConfigurations:UpdateIndex' :: Maybe [UserTokenConfiguration]
userTokenConfigurations = Maybe [UserTokenConfiguration]
a} :: UpdateIndex) 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 of the index you want to update.
updateIndex_id :: Lens.Lens' UpdateIndex Prelude.Text
updateIndex_id :: Lens' UpdateIndex Text
updateIndex_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateIndex' {Text
id :: Text
$sel:id:UpdateIndex' :: UpdateIndex -> Text
id} -> Text
id) (\s :: UpdateIndex
s@UpdateIndex' {} Text
a -> UpdateIndex
s {$sel:id:UpdateIndex' :: Text
id = Text
a} :: UpdateIndex)

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

instance Prelude.Hashable UpdateIndex where
  hashWithSalt :: Int -> UpdateIndex -> Int
hashWithSalt Int
_salt UpdateIndex' {Maybe [DocumentMetadataConfiguration]
Maybe [UserTokenConfiguration]
Maybe Text
Maybe CapacityUnitsConfiguration
Maybe UserContextPolicy
Maybe UserGroupResolutionConfiguration
Text
id :: Text
userTokenConfigurations :: Maybe [UserTokenConfiguration]
userGroupResolutionConfiguration :: Maybe UserGroupResolutionConfiguration
userContextPolicy :: Maybe UserContextPolicy
roleArn :: Maybe Text
name :: Maybe Text
documentMetadataConfigurationUpdates :: Maybe [DocumentMetadataConfiguration]
description :: Maybe Text
capacityUnits :: Maybe CapacityUnitsConfiguration
$sel:id:UpdateIndex' :: UpdateIndex -> Text
$sel:userTokenConfigurations:UpdateIndex' :: UpdateIndex -> Maybe [UserTokenConfiguration]
$sel:userGroupResolutionConfiguration:UpdateIndex' :: UpdateIndex -> Maybe UserGroupResolutionConfiguration
$sel:userContextPolicy:UpdateIndex' :: UpdateIndex -> Maybe UserContextPolicy
$sel:roleArn:UpdateIndex' :: UpdateIndex -> Maybe Text
$sel:name:UpdateIndex' :: UpdateIndex -> Maybe Text
$sel:documentMetadataConfigurationUpdates:UpdateIndex' :: UpdateIndex -> Maybe [DocumentMetadataConfiguration]
$sel:description:UpdateIndex' :: UpdateIndex -> Maybe Text
$sel:capacityUnits:UpdateIndex' :: UpdateIndex -> Maybe CapacityUnitsConfiguration
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CapacityUnitsConfiguration
capacityUnits
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [DocumentMetadataConfiguration]
documentMetadataConfigurationUpdates
      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 UserContextPolicy
userContextPolicy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe UserGroupResolutionConfiguration
userGroupResolutionConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [UserTokenConfiguration]
userTokenConfigurations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id

instance Prelude.NFData UpdateIndex where
  rnf :: UpdateIndex -> ()
rnf UpdateIndex' {Maybe [DocumentMetadataConfiguration]
Maybe [UserTokenConfiguration]
Maybe Text
Maybe CapacityUnitsConfiguration
Maybe UserContextPolicy
Maybe UserGroupResolutionConfiguration
Text
id :: Text
userTokenConfigurations :: Maybe [UserTokenConfiguration]
userGroupResolutionConfiguration :: Maybe UserGroupResolutionConfiguration
userContextPolicy :: Maybe UserContextPolicy
roleArn :: Maybe Text
name :: Maybe Text
documentMetadataConfigurationUpdates :: Maybe [DocumentMetadataConfiguration]
description :: Maybe Text
capacityUnits :: Maybe CapacityUnitsConfiguration
$sel:id:UpdateIndex' :: UpdateIndex -> Text
$sel:userTokenConfigurations:UpdateIndex' :: UpdateIndex -> Maybe [UserTokenConfiguration]
$sel:userGroupResolutionConfiguration:UpdateIndex' :: UpdateIndex -> Maybe UserGroupResolutionConfiguration
$sel:userContextPolicy:UpdateIndex' :: UpdateIndex -> Maybe UserContextPolicy
$sel:roleArn:UpdateIndex' :: UpdateIndex -> Maybe Text
$sel:name:UpdateIndex' :: UpdateIndex -> Maybe Text
$sel:documentMetadataConfigurationUpdates:UpdateIndex' :: UpdateIndex -> Maybe [DocumentMetadataConfiguration]
$sel:description:UpdateIndex' :: UpdateIndex -> Maybe Text
$sel:capacityUnits:UpdateIndex' :: UpdateIndex -> Maybe CapacityUnitsConfiguration
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CapacityUnitsConfiguration
capacityUnits
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 [DocumentMetadataConfiguration]
documentMetadataConfigurationUpdates
      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 UserContextPolicy
userContextPolicy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe UserGroupResolutionConfiguration
userGroupResolutionConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [UserTokenConfiguration]
userTokenConfigurations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id

instance Data.ToHeaders UpdateIndex where
  toHeaders :: UpdateIndex -> [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.UpdateIndex" ::
                          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 UpdateIndex where
  toJSON :: UpdateIndex -> Value
toJSON UpdateIndex' {Maybe [DocumentMetadataConfiguration]
Maybe [UserTokenConfiguration]
Maybe Text
Maybe CapacityUnitsConfiguration
Maybe UserContextPolicy
Maybe UserGroupResolutionConfiguration
Text
id :: Text
userTokenConfigurations :: Maybe [UserTokenConfiguration]
userGroupResolutionConfiguration :: Maybe UserGroupResolutionConfiguration
userContextPolicy :: Maybe UserContextPolicy
roleArn :: Maybe Text
name :: Maybe Text
documentMetadataConfigurationUpdates :: Maybe [DocumentMetadataConfiguration]
description :: Maybe Text
capacityUnits :: Maybe CapacityUnitsConfiguration
$sel:id:UpdateIndex' :: UpdateIndex -> Text
$sel:userTokenConfigurations:UpdateIndex' :: UpdateIndex -> Maybe [UserTokenConfiguration]
$sel:userGroupResolutionConfiguration:UpdateIndex' :: UpdateIndex -> Maybe UserGroupResolutionConfiguration
$sel:userContextPolicy:UpdateIndex' :: UpdateIndex -> Maybe UserContextPolicy
$sel:roleArn:UpdateIndex' :: UpdateIndex -> Maybe Text
$sel:name:UpdateIndex' :: UpdateIndex -> Maybe Text
$sel:documentMetadataConfigurationUpdates:UpdateIndex' :: UpdateIndex -> Maybe [DocumentMetadataConfiguration]
$sel:description:UpdateIndex' :: UpdateIndex -> Maybe Text
$sel:capacityUnits:UpdateIndex' :: UpdateIndex -> Maybe CapacityUnitsConfiguration
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CapacityUnits" 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 CapacityUnitsConfiguration
capacityUnits,
            (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
"DocumentMetadataConfigurationUpdates" 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 [DocumentMetadataConfiguration]
documentMetadataConfigurationUpdates,
            (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
"UserContextPolicy" 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 UserContextPolicy
userContextPolicy,
            (Key
"UserGroupResolutionConfiguration" 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 UserGroupResolutionConfiguration
userGroupResolutionConfiguration,
            (Key
"UserTokenConfigurations" 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 [UserTokenConfiguration]
userTokenConfigurations,
            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 UpdateIndex where
  toPath :: UpdateIndex -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

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

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