{-# 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.CreateIndex
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates an Amazon Kendra index. Index creation is an asynchronous API.
-- To determine if index creation has completed, check the @Status@ field
-- returned from a call to @DescribeIndex@. The @Status@ field is set to
-- @ACTIVE@ when the index is ready to use.
--
-- Once the index is active you can index your documents using the
-- @BatchPutDocument@ API or using one of the supported data sources.
--
-- For an example of creating an index and data source using the Python
-- SDK, see
-- <https://docs.aws.amazon.com/kendra/latest/dg/gs-python.html Getting started with Python SDK>.
-- For an example of creating an index and data source using the Java SDK,
-- see
-- <https://docs.aws.amazon.com/kendra/latest/dg/gs-java.html Getting started with Java SDK>.
module Amazonka.Kendra.CreateIndex
  ( -- * Creating a Request
    CreateIndex (..),
    newCreateIndex,

    -- * Request Lenses
    createIndex_clientToken,
    createIndex_description,
    createIndex_edition,
    createIndex_serverSideEncryptionConfiguration,
    createIndex_tags,
    createIndex_userContextPolicy,
    createIndex_userGroupResolutionConfiguration,
    createIndex_userTokenConfigurations,
    createIndex_name,
    createIndex_roleArn,

    -- * Destructuring the Response
    CreateIndexResponse (..),
    newCreateIndexResponse,

    -- * Response Lenses
    createIndexResponse_id,
    createIndexResponse_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:/ 'newCreateIndex' smart constructor.
data CreateIndex = CreateIndex'
  { -- | A token that you provide to identify the request to create an index.
    -- Multiple calls to the @CreateIndex@ API with the same client token will
    -- create only one index.
    CreateIndex -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | A description for the index.
    CreateIndex -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Kendra edition to use for the index. Choose
    -- @DEVELOPER_EDITION@ for indexes intended for development, testing, or
    -- proof of concept. Use @ENTERPRISE_EDITION@ for your production
    -- databases. Once you set the edition for an index, it can\'t be changed.
    --
    -- The @Edition@ parameter is optional. If you don\'t supply a value, the
    -- default is @ENTERPRISE_EDITION@.
    --
    -- For more information on quota limits for enterprise and developer
    -- editions, see
    -- <https://docs.aws.amazon.com/kendra/latest/dg/quotas.html Quotas>.
    CreateIndex -> Maybe IndexEdition
edition :: Prelude.Maybe IndexEdition,
    -- | The identifier of the KMS customer managed key (CMK) that\'s used to
    -- encrypt data indexed by Amazon Kendra. Amazon Kendra doesn\'t support
    -- asymmetric CMKs.
    CreateIndex -> Maybe ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration :: Prelude.Maybe ServerSideEncryptionConfiguration,
    -- | A list of key-value pairs that identify the index. You can use the tags
    -- to identify and organize your resources and to control access to
    -- resources.
    CreateIndex -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The user context policy.
    --
    -- [ATTRIBUTE_FILTER]
    --     All indexed content is searchable and displayable for all users. If
    --     you want to filter search results on user context, you can use the
    --     attribute filters of @_user_id@ and @_group_ids@ or you can provide
    --     user and group information in @UserContext@.
    --
    -- [USER_TOKEN]
    --     Enables token-based user access control to filter search results on
    --     user context. All documents with no access control and all documents
    --     accessible to the user will be searchable and displayable.
    CreateIndex -> 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>.
    CreateIndex -> Maybe UserGroupResolutionConfiguration
userGroupResolutionConfiguration :: Prelude.Maybe UserGroupResolutionConfiguration,
    -- | The user token configuration.
    CreateIndex -> Maybe [UserTokenConfiguration]
userTokenConfigurations :: Prelude.Maybe [UserTokenConfiguration],
    -- | A name for the index.
    CreateIndex -> Text
name :: Prelude.Text,
    -- | An Identity and Access Management (IAM) role that gives Amazon Kendra
    -- permissions to access your Amazon CloudWatch logs and metrics. This is
    -- also the role you use when you call the @BatchPutDocument@ API to index
    -- documents from an Amazon S3 bucket.
    CreateIndex -> Text
roleArn :: Prelude.Text
  }
  deriving (CreateIndex -> CreateIndex -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateIndex -> CreateIndex -> Bool
$c/= :: CreateIndex -> CreateIndex -> Bool
== :: CreateIndex -> CreateIndex -> Bool
$c== :: CreateIndex -> CreateIndex -> Bool
Prelude.Eq, Int -> CreateIndex -> ShowS
[CreateIndex] -> ShowS
CreateIndex -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateIndex] -> ShowS
$cshowList :: [CreateIndex] -> ShowS
show :: CreateIndex -> String
$cshow :: CreateIndex -> String
showsPrec :: Int -> CreateIndex -> ShowS
$cshowsPrec :: Int -> CreateIndex -> ShowS
Prelude.Show, forall x. Rep CreateIndex x -> CreateIndex
forall x. CreateIndex -> Rep CreateIndex x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateIndex x -> CreateIndex
$cfrom :: forall x. CreateIndex -> Rep CreateIndex x
Prelude.Generic)

-- |
-- Create a value of 'CreateIndex' 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:
--
-- 'clientToken', 'createIndex_clientToken' - A token that you provide to identify the request to create an index.
-- Multiple calls to the @CreateIndex@ API with the same client token will
-- create only one index.
--
-- 'description', 'createIndex_description' - A description for the index.
--
-- 'edition', 'createIndex_edition' - The Amazon Kendra edition to use for the index. Choose
-- @DEVELOPER_EDITION@ for indexes intended for development, testing, or
-- proof of concept. Use @ENTERPRISE_EDITION@ for your production
-- databases. Once you set the edition for an index, it can\'t be changed.
--
-- The @Edition@ parameter is optional. If you don\'t supply a value, the
-- default is @ENTERPRISE_EDITION@.
--
-- For more information on quota limits for enterprise and developer
-- editions, see
-- <https://docs.aws.amazon.com/kendra/latest/dg/quotas.html Quotas>.
--
-- 'serverSideEncryptionConfiguration', 'createIndex_serverSideEncryptionConfiguration' - The identifier of the KMS customer managed key (CMK) that\'s used to
-- encrypt data indexed by Amazon Kendra. Amazon Kendra doesn\'t support
-- asymmetric CMKs.
--
-- 'tags', 'createIndex_tags' - A list of key-value pairs that identify the index. You can use the tags
-- to identify and organize your resources and to control access to
-- resources.
--
-- 'userContextPolicy', 'createIndex_userContextPolicy' - The user context policy.
--
-- [ATTRIBUTE_FILTER]
--     All indexed content is searchable and displayable for all users. If
--     you want to filter search results on user context, you can use the
--     attribute filters of @_user_id@ and @_group_ids@ or you can provide
--     user and group information in @UserContext@.
--
-- [USER_TOKEN]
--     Enables token-based user access control to filter search results on
--     user context. All documents with no access control and all documents
--     accessible to the user will be searchable and displayable.
--
-- 'userGroupResolutionConfiguration', 'createIndex_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', 'createIndex_userTokenConfigurations' - The user token configuration.
--
-- 'name', 'createIndex_name' - A name for the index.
--
-- 'roleArn', 'createIndex_roleArn' - An Identity and Access Management (IAM) role that gives Amazon Kendra
-- permissions to access your Amazon CloudWatch logs and metrics. This is
-- also the role you use when you call the @BatchPutDocument@ API to index
-- documents from an Amazon S3 bucket.
newCreateIndex ::
  -- | 'name'
  Prelude.Text ->
  -- | 'roleArn'
  Prelude.Text ->
  CreateIndex
newCreateIndex :: Text -> Text -> CreateIndex
newCreateIndex Text
pName_ Text
pRoleArn_ =
  CreateIndex'
    { $sel:clientToken:CreateIndex' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreateIndex' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:edition:CreateIndex' :: Maybe IndexEdition
edition = forall a. Maybe a
Prelude.Nothing,
      $sel:serverSideEncryptionConfiguration:CreateIndex' :: Maybe ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateIndex' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:userContextPolicy:CreateIndex' :: Maybe UserContextPolicy
userContextPolicy = forall a. Maybe a
Prelude.Nothing,
      $sel:userGroupResolutionConfiguration:CreateIndex' :: Maybe UserGroupResolutionConfiguration
userGroupResolutionConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:userTokenConfigurations:CreateIndex' :: Maybe [UserTokenConfiguration]
userTokenConfigurations = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreateIndex' :: Text
name = Text
pName_,
      $sel:roleArn:CreateIndex' :: Text
roleArn = Text
pRoleArn_
    }

-- | A token that you provide to identify the request to create an index.
-- Multiple calls to the @CreateIndex@ API with the same client token will
-- create only one index.
createIndex_clientToken :: Lens.Lens' CreateIndex (Prelude.Maybe Prelude.Text)
createIndex_clientToken :: Lens' CreateIndex (Maybe Text)
createIndex_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIndex' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateIndex' :: CreateIndex -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateIndex
s@CreateIndex' {} Maybe Text
a -> CreateIndex
s {$sel:clientToken:CreateIndex' :: Maybe Text
clientToken = Maybe Text
a} :: CreateIndex)

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

-- | The Amazon Kendra edition to use for the index. Choose
-- @DEVELOPER_EDITION@ for indexes intended for development, testing, or
-- proof of concept. Use @ENTERPRISE_EDITION@ for your production
-- databases. Once you set the edition for an index, it can\'t be changed.
--
-- The @Edition@ parameter is optional. If you don\'t supply a value, the
-- default is @ENTERPRISE_EDITION@.
--
-- For more information on quota limits for enterprise and developer
-- editions, see
-- <https://docs.aws.amazon.com/kendra/latest/dg/quotas.html Quotas>.
createIndex_edition :: Lens.Lens' CreateIndex (Prelude.Maybe IndexEdition)
createIndex_edition :: Lens' CreateIndex (Maybe IndexEdition)
createIndex_edition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIndex' {Maybe IndexEdition
edition :: Maybe IndexEdition
$sel:edition:CreateIndex' :: CreateIndex -> Maybe IndexEdition
edition} -> Maybe IndexEdition
edition) (\s :: CreateIndex
s@CreateIndex' {} Maybe IndexEdition
a -> CreateIndex
s {$sel:edition:CreateIndex' :: Maybe IndexEdition
edition = Maybe IndexEdition
a} :: CreateIndex)

-- | The identifier of the KMS customer managed key (CMK) that\'s used to
-- encrypt data indexed by Amazon Kendra. Amazon Kendra doesn\'t support
-- asymmetric CMKs.
createIndex_serverSideEncryptionConfiguration :: Lens.Lens' CreateIndex (Prelude.Maybe ServerSideEncryptionConfiguration)
createIndex_serverSideEncryptionConfiguration :: Lens' CreateIndex (Maybe ServerSideEncryptionConfiguration)
createIndex_serverSideEncryptionConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIndex' {Maybe ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration :: Maybe ServerSideEncryptionConfiguration
$sel:serverSideEncryptionConfiguration:CreateIndex' :: CreateIndex -> Maybe ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration} -> Maybe ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration) (\s :: CreateIndex
s@CreateIndex' {} Maybe ServerSideEncryptionConfiguration
a -> CreateIndex
s {$sel:serverSideEncryptionConfiguration:CreateIndex' :: Maybe ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration = Maybe ServerSideEncryptionConfiguration
a} :: CreateIndex)

-- | A list of key-value pairs that identify the index. You can use the tags
-- to identify and organize your resources and to control access to
-- resources.
createIndex_tags :: Lens.Lens' CreateIndex (Prelude.Maybe [Tag])
createIndex_tags :: Lens' CreateIndex (Maybe [Tag])
createIndex_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIndex' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateIndex' :: CreateIndex -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateIndex
s@CreateIndex' {} Maybe [Tag]
a -> CreateIndex
s {$sel:tags:CreateIndex' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateIndex) 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 user context policy.
--
-- [ATTRIBUTE_FILTER]
--     All indexed content is searchable and displayable for all users. If
--     you want to filter search results on user context, you can use the
--     attribute filters of @_user_id@ and @_group_ids@ or you can provide
--     user and group information in @UserContext@.
--
-- [USER_TOKEN]
--     Enables token-based user access control to filter search results on
--     user context. All documents with no access control and all documents
--     accessible to the user will be searchable and displayable.
createIndex_userContextPolicy :: Lens.Lens' CreateIndex (Prelude.Maybe UserContextPolicy)
createIndex_userContextPolicy :: Lens' CreateIndex (Maybe UserContextPolicy)
createIndex_userContextPolicy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIndex' {Maybe UserContextPolicy
userContextPolicy :: Maybe UserContextPolicy
$sel:userContextPolicy:CreateIndex' :: CreateIndex -> Maybe UserContextPolicy
userContextPolicy} -> Maybe UserContextPolicy
userContextPolicy) (\s :: CreateIndex
s@CreateIndex' {} Maybe UserContextPolicy
a -> CreateIndex
s {$sel:userContextPolicy:CreateIndex' :: Maybe UserContextPolicy
userContextPolicy = Maybe UserContextPolicy
a} :: CreateIndex)

-- | 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>.
createIndex_userGroupResolutionConfiguration :: Lens.Lens' CreateIndex (Prelude.Maybe UserGroupResolutionConfiguration)
createIndex_userGroupResolutionConfiguration :: Lens' CreateIndex (Maybe UserGroupResolutionConfiguration)
createIndex_userGroupResolutionConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIndex' {Maybe UserGroupResolutionConfiguration
userGroupResolutionConfiguration :: Maybe UserGroupResolutionConfiguration
$sel:userGroupResolutionConfiguration:CreateIndex' :: CreateIndex -> Maybe UserGroupResolutionConfiguration
userGroupResolutionConfiguration} -> Maybe UserGroupResolutionConfiguration
userGroupResolutionConfiguration) (\s :: CreateIndex
s@CreateIndex' {} Maybe UserGroupResolutionConfiguration
a -> CreateIndex
s {$sel:userGroupResolutionConfiguration:CreateIndex' :: Maybe UserGroupResolutionConfiguration
userGroupResolutionConfiguration = Maybe UserGroupResolutionConfiguration
a} :: CreateIndex)

-- | The user token configuration.
createIndex_userTokenConfigurations :: Lens.Lens' CreateIndex (Prelude.Maybe [UserTokenConfiguration])
createIndex_userTokenConfigurations :: Lens' CreateIndex (Maybe [UserTokenConfiguration])
createIndex_userTokenConfigurations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIndex' {Maybe [UserTokenConfiguration]
userTokenConfigurations :: Maybe [UserTokenConfiguration]
$sel:userTokenConfigurations:CreateIndex' :: CreateIndex -> Maybe [UserTokenConfiguration]
userTokenConfigurations} -> Maybe [UserTokenConfiguration]
userTokenConfigurations) (\s :: CreateIndex
s@CreateIndex' {} Maybe [UserTokenConfiguration]
a -> CreateIndex
s {$sel:userTokenConfigurations:CreateIndex' :: Maybe [UserTokenConfiguration]
userTokenConfigurations = Maybe [UserTokenConfiguration]
a} :: CreateIndex) 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 name for the index.
createIndex_name :: Lens.Lens' CreateIndex Prelude.Text
createIndex_name :: Lens' CreateIndex Text
createIndex_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIndex' {Text
name :: Text
$sel:name:CreateIndex' :: CreateIndex -> Text
name} -> Text
name) (\s :: CreateIndex
s@CreateIndex' {} Text
a -> CreateIndex
s {$sel:name:CreateIndex' :: Text
name = Text
a} :: CreateIndex)

-- | An Identity and Access Management (IAM) role that gives Amazon Kendra
-- permissions to access your Amazon CloudWatch logs and metrics. This is
-- also the role you use when you call the @BatchPutDocument@ API to index
-- documents from an Amazon S3 bucket.
createIndex_roleArn :: Lens.Lens' CreateIndex Prelude.Text
createIndex_roleArn :: Lens' CreateIndex Text
createIndex_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIndex' {Text
roleArn :: Text
$sel:roleArn:CreateIndex' :: CreateIndex -> Text
roleArn} -> Text
roleArn) (\s :: CreateIndex
s@CreateIndex' {} Text
a -> CreateIndex
s {$sel:roleArn:CreateIndex' :: Text
roleArn = Text
a} :: CreateIndex)

instance Core.AWSRequest CreateIndex where
  type AWSResponse CreateIndex = CreateIndexResponse
  request :: (Service -> Service) -> CreateIndex -> Request CreateIndex
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 CreateIndex
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateIndex)))
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 Text -> Int -> CreateIndexResponse
CreateIndexResponse'
            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
"Id")
            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 CreateIndex where
  hashWithSalt :: Int -> CreateIndex -> Int
hashWithSalt Int
_salt CreateIndex' {Maybe [Tag]
Maybe [UserTokenConfiguration]
Maybe Text
Maybe IndexEdition
Maybe ServerSideEncryptionConfiguration
Maybe UserContextPolicy
Maybe UserGroupResolutionConfiguration
Text
roleArn :: Text
name :: Text
userTokenConfigurations :: Maybe [UserTokenConfiguration]
userGroupResolutionConfiguration :: Maybe UserGroupResolutionConfiguration
userContextPolicy :: Maybe UserContextPolicy
tags :: Maybe [Tag]
serverSideEncryptionConfiguration :: Maybe ServerSideEncryptionConfiguration
edition :: Maybe IndexEdition
description :: Maybe Text
clientToken :: Maybe Text
$sel:roleArn:CreateIndex' :: CreateIndex -> Text
$sel:name:CreateIndex' :: CreateIndex -> Text
$sel:userTokenConfigurations:CreateIndex' :: CreateIndex -> Maybe [UserTokenConfiguration]
$sel:userGroupResolutionConfiguration:CreateIndex' :: CreateIndex -> Maybe UserGroupResolutionConfiguration
$sel:userContextPolicy:CreateIndex' :: CreateIndex -> Maybe UserContextPolicy
$sel:tags:CreateIndex' :: CreateIndex -> Maybe [Tag]
$sel:serverSideEncryptionConfiguration:CreateIndex' :: CreateIndex -> Maybe ServerSideEncryptionConfiguration
$sel:edition:CreateIndex' :: CreateIndex -> Maybe IndexEdition
$sel:description:CreateIndex' :: CreateIndex -> Maybe Text
$sel:clientToken:CreateIndex' :: CreateIndex -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe IndexEdition
edition
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      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
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleArn

instance Prelude.NFData CreateIndex where
  rnf :: CreateIndex -> ()
rnf CreateIndex' {Maybe [Tag]
Maybe [UserTokenConfiguration]
Maybe Text
Maybe IndexEdition
Maybe ServerSideEncryptionConfiguration
Maybe UserContextPolicy
Maybe UserGroupResolutionConfiguration
Text
roleArn :: Text
name :: Text
userTokenConfigurations :: Maybe [UserTokenConfiguration]
userGroupResolutionConfiguration :: Maybe UserGroupResolutionConfiguration
userContextPolicy :: Maybe UserContextPolicy
tags :: Maybe [Tag]
serverSideEncryptionConfiguration :: Maybe ServerSideEncryptionConfiguration
edition :: Maybe IndexEdition
description :: Maybe Text
clientToken :: Maybe Text
$sel:roleArn:CreateIndex' :: CreateIndex -> Text
$sel:name:CreateIndex' :: CreateIndex -> Text
$sel:userTokenConfigurations:CreateIndex' :: CreateIndex -> Maybe [UserTokenConfiguration]
$sel:userGroupResolutionConfiguration:CreateIndex' :: CreateIndex -> Maybe UserGroupResolutionConfiguration
$sel:userContextPolicy:CreateIndex' :: CreateIndex -> Maybe UserContextPolicy
$sel:tags:CreateIndex' :: CreateIndex -> Maybe [Tag]
$sel:serverSideEncryptionConfiguration:CreateIndex' :: CreateIndex -> Maybe ServerSideEncryptionConfiguration
$sel:edition:CreateIndex' :: CreateIndex -> Maybe IndexEdition
$sel:description:CreateIndex' :: CreateIndex -> Maybe Text
$sel:clientToken:CreateIndex' :: CreateIndex -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      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 IndexEdition
edition
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      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
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roleArn

instance Data.ToHeaders CreateIndex where
  toHeaders :: CreateIndex -> 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.CreateIndex" ::
                          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 CreateIndex where
  toJSON :: CreateIndex -> Value
toJSON CreateIndex' {Maybe [Tag]
Maybe [UserTokenConfiguration]
Maybe Text
Maybe IndexEdition
Maybe ServerSideEncryptionConfiguration
Maybe UserContextPolicy
Maybe UserGroupResolutionConfiguration
Text
roleArn :: Text
name :: Text
userTokenConfigurations :: Maybe [UserTokenConfiguration]
userGroupResolutionConfiguration :: Maybe UserGroupResolutionConfiguration
userContextPolicy :: Maybe UserContextPolicy
tags :: Maybe [Tag]
serverSideEncryptionConfiguration :: Maybe ServerSideEncryptionConfiguration
edition :: Maybe IndexEdition
description :: Maybe Text
clientToken :: Maybe Text
$sel:roleArn:CreateIndex' :: CreateIndex -> Text
$sel:name:CreateIndex' :: CreateIndex -> Text
$sel:userTokenConfigurations:CreateIndex' :: CreateIndex -> Maybe [UserTokenConfiguration]
$sel:userGroupResolutionConfiguration:CreateIndex' :: CreateIndex -> Maybe UserGroupResolutionConfiguration
$sel:userContextPolicy:CreateIndex' :: CreateIndex -> Maybe UserContextPolicy
$sel:tags:CreateIndex' :: CreateIndex -> Maybe [Tag]
$sel:serverSideEncryptionConfiguration:CreateIndex' :: CreateIndex -> Maybe ServerSideEncryptionConfiguration
$sel:edition:CreateIndex' :: CreateIndex -> Maybe IndexEdition
$sel:description:CreateIndex' :: CreateIndex -> Maybe Text
$sel:clientToken:CreateIndex' :: CreateIndex -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientToken" 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
clientToken,
            (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
"Edition" 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 IndexEdition
edition,
            (Key
"ServerSideEncryptionConfiguration" 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 ServerSideEncryptionConfiguration
serverSideEncryptionConfiguration,
            (Key
"Tags" 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 [Tag]
tags,
            (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
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"RoleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
roleArn)
          ]
      )

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

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

-- | /See:/ 'newCreateIndexResponse' smart constructor.
data CreateIndexResponse = CreateIndexResponse'
  { -- | The identifier of the index. Use this identifier when you query an
    -- index, set up a data source, or index a document.
    CreateIndexResponse -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateIndexResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateIndexResponse -> CreateIndexResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateIndexResponse -> CreateIndexResponse -> Bool
$c/= :: CreateIndexResponse -> CreateIndexResponse -> Bool
== :: CreateIndexResponse -> CreateIndexResponse -> Bool
$c== :: CreateIndexResponse -> CreateIndexResponse -> Bool
Prelude.Eq, ReadPrec [CreateIndexResponse]
ReadPrec CreateIndexResponse
Int -> ReadS CreateIndexResponse
ReadS [CreateIndexResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateIndexResponse]
$creadListPrec :: ReadPrec [CreateIndexResponse]
readPrec :: ReadPrec CreateIndexResponse
$creadPrec :: ReadPrec CreateIndexResponse
readList :: ReadS [CreateIndexResponse]
$creadList :: ReadS [CreateIndexResponse]
readsPrec :: Int -> ReadS CreateIndexResponse
$creadsPrec :: Int -> ReadS CreateIndexResponse
Prelude.Read, Int -> CreateIndexResponse -> ShowS
[CreateIndexResponse] -> ShowS
CreateIndexResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateIndexResponse] -> ShowS
$cshowList :: [CreateIndexResponse] -> ShowS
show :: CreateIndexResponse -> String
$cshow :: CreateIndexResponse -> String
showsPrec :: Int -> CreateIndexResponse -> ShowS
$cshowsPrec :: Int -> CreateIndexResponse -> ShowS
Prelude.Show, forall x. Rep CreateIndexResponse x -> CreateIndexResponse
forall x. CreateIndexResponse -> Rep CreateIndexResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateIndexResponse x -> CreateIndexResponse
$cfrom :: forall x. CreateIndexResponse -> Rep CreateIndexResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateIndexResponse' 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:
--
-- 'id', 'createIndexResponse_id' - The identifier of the index. Use this identifier when you query an
-- index, set up a data source, or index a document.
--
-- 'httpStatus', 'createIndexResponse_httpStatus' - The response's http status code.
newCreateIndexResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateIndexResponse
newCreateIndexResponse :: Int -> CreateIndexResponse
newCreateIndexResponse Int
pHttpStatus_ =
  CreateIndexResponse'
    { $sel:id:CreateIndexResponse' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateIndexResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The identifier of the index. Use this identifier when you query an
-- index, set up a data source, or index a document.
createIndexResponse_id :: Lens.Lens' CreateIndexResponse (Prelude.Maybe Prelude.Text)
createIndexResponse_id :: Lens' CreateIndexResponse (Maybe Text)
createIndexResponse_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateIndexResponse' {Maybe Text
id :: Maybe Text
$sel:id:CreateIndexResponse' :: CreateIndexResponse -> Maybe Text
id} -> Maybe Text
id) (\s :: CreateIndexResponse
s@CreateIndexResponse' {} Maybe Text
a -> CreateIndexResponse
s {$sel:id:CreateIndexResponse' :: Maybe Text
id = Maybe Text
a} :: CreateIndexResponse)

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

instance Prelude.NFData CreateIndexResponse where
  rnf :: CreateIndexResponse -> ()
rnf CreateIndexResponse' {Int
Maybe Text
httpStatus :: Int
id :: Maybe Text
$sel:httpStatus:CreateIndexResponse' :: CreateIndexResponse -> Int
$sel:id:CreateIndexResponse' :: CreateIndexResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus