{-# 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.UpdateDataSource
-- 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 data source connector.
module Amazonka.Kendra.UpdateDataSource
  ( -- * Creating a Request
    UpdateDataSource (..),
    newUpdateDataSource,

    -- * Request Lenses
    updateDataSource_configuration,
    updateDataSource_customDocumentEnrichmentConfiguration,
    updateDataSource_description,
    updateDataSource_languageCode,
    updateDataSource_name,
    updateDataSource_roleArn,
    updateDataSource_schedule,
    updateDataSource_vpcConfiguration,
    updateDataSource_id,
    updateDataSource_indexId,

    -- * Destructuring the Response
    UpdateDataSourceResponse (..),
    newUpdateDataSourceResponse,
  )
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:/ 'newUpdateDataSource' smart constructor.
data UpdateDataSource = UpdateDataSource'
  { -- | Configuration information you want to update for the data source
    -- connector.
    UpdateDataSource -> Maybe DataSourceConfiguration
configuration :: Prelude.Maybe DataSourceConfiguration,
    -- | Configuration information you want to update for altering document
    -- metadata and content during the document ingestion process.
    --
    -- For more information on how to create, modify and delete document
    -- metadata, or make other content alterations when you ingest documents
    -- into Amazon Kendra, see
    -- <https://docs.aws.amazon.com/kendra/latest/dg/custom-document-enrichment.html Customizing document metadata during the ingestion process>.
    UpdateDataSource -> Maybe CustomDocumentEnrichmentConfiguration
customDocumentEnrichmentConfiguration :: Prelude.Maybe CustomDocumentEnrichmentConfiguration,
    -- | A new description for the data source connector.
    UpdateDataSource -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The code for a language you want to update for the data source
    -- connector. This allows you to support a language for all documents when
    -- updating the data source. English is supported by default. For more
    -- information on supported languages, including their codes, see
    -- <https://docs.aws.amazon.com/kendra/latest/dg/in-adding-languages.html Adding documents in languages other than English>.
    UpdateDataSource -> Maybe Text
languageCode :: Prelude.Maybe Prelude.Text,
    -- | A new name for the data source connector.
    UpdateDataSource -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of a role with permission to access the
    -- data source and required resources. For more information, see
    -- <https://docs.aws.amazon.com/kendra/latest/dg/iam-roles.html IAM roles for Amazon Kendra>.
    UpdateDataSource -> Maybe Text
roleArn :: Prelude.Maybe Prelude.Text,
    -- | The sync schedule you want to update for the data source connector.
    UpdateDataSource -> Maybe Text
schedule :: Prelude.Maybe Prelude.Text,
    -- | Configuration information for an Amazon Virtual Private Cloud to connect
    -- to your data source. For more information, see
    -- <https://docs.aws.amazon.com/kendra/latest/dg/vpc-configuration.html Configuring a VPC>.
    UpdateDataSource -> Maybe DataSourceVpcConfiguration
vpcConfiguration :: Prelude.Maybe DataSourceVpcConfiguration,
    -- | The identifier of the data source connector you want to update.
    UpdateDataSource -> Text
id :: Prelude.Text,
    -- | The identifier of the index used with the data source connector.
    UpdateDataSource -> Text
indexId :: Prelude.Text
  }
  deriving (UpdateDataSource -> UpdateDataSource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDataSource -> UpdateDataSource -> Bool
$c/= :: UpdateDataSource -> UpdateDataSource -> Bool
== :: UpdateDataSource -> UpdateDataSource -> Bool
$c== :: UpdateDataSource -> UpdateDataSource -> Bool
Prelude.Eq, ReadPrec [UpdateDataSource]
ReadPrec UpdateDataSource
Int -> ReadS UpdateDataSource
ReadS [UpdateDataSource]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateDataSource]
$creadListPrec :: ReadPrec [UpdateDataSource]
readPrec :: ReadPrec UpdateDataSource
$creadPrec :: ReadPrec UpdateDataSource
readList :: ReadS [UpdateDataSource]
$creadList :: ReadS [UpdateDataSource]
readsPrec :: Int -> ReadS UpdateDataSource
$creadsPrec :: Int -> ReadS UpdateDataSource
Prelude.Read, Int -> UpdateDataSource -> ShowS
[UpdateDataSource] -> ShowS
UpdateDataSource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDataSource] -> ShowS
$cshowList :: [UpdateDataSource] -> ShowS
show :: UpdateDataSource -> String
$cshow :: UpdateDataSource -> String
showsPrec :: Int -> UpdateDataSource -> ShowS
$cshowsPrec :: Int -> UpdateDataSource -> ShowS
Prelude.Show, forall x. Rep UpdateDataSource x -> UpdateDataSource
forall x. UpdateDataSource -> Rep UpdateDataSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateDataSource x -> UpdateDataSource
$cfrom :: forall x. UpdateDataSource -> Rep UpdateDataSource x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDataSource' 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:
--
-- 'configuration', 'updateDataSource_configuration' - Configuration information you want to update for the data source
-- connector.
--
-- 'customDocumentEnrichmentConfiguration', 'updateDataSource_customDocumentEnrichmentConfiguration' - Configuration information you want to update for altering document
-- metadata and content during the document ingestion process.
--
-- For more information on how to create, modify and delete document
-- metadata, or make other content alterations when you ingest documents
-- into Amazon Kendra, see
-- <https://docs.aws.amazon.com/kendra/latest/dg/custom-document-enrichment.html Customizing document metadata during the ingestion process>.
--
-- 'description', 'updateDataSource_description' - A new description for the data source connector.
--
-- 'languageCode', 'updateDataSource_languageCode' - The code for a language you want to update for the data source
-- connector. This allows you to support a language for all documents when
-- updating the data source. English is supported by default. For more
-- information on supported languages, including their codes, see
-- <https://docs.aws.amazon.com/kendra/latest/dg/in-adding-languages.html Adding documents in languages other than English>.
--
-- 'name', 'updateDataSource_name' - A new name for the data source connector.
--
-- 'roleArn', 'updateDataSource_roleArn' - The Amazon Resource Name (ARN) of a role with permission to access the
-- data source and required resources. For more information, see
-- <https://docs.aws.amazon.com/kendra/latest/dg/iam-roles.html IAM roles for Amazon Kendra>.
--
-- 'schedule', 'updateDataSource_schedule' - The sync schedule you want to update for the data source connector.
--
-- 'vpcConfiguration', 'updateDataSource_vpcConfiguration' - Configuration information for an Amazon Virtual Private Cloud to connect
-- to your data source. For more information, see
-- <https://docs.aws.amazon.com/kendra/latest/dg/vpc-configuration.html Configuring a VPC>.
--
-- 'id', 'updateDataSource_id' - The identifier of the data source connector you want to update.
--
-- 'indexId', 'updateDataSource_indexId' - The identifier of the index used with the data source connector.
newUpdateDataSource ::
  -- | 'id'
  Prelude.Text ->
  -- | 'indexId'
  Prelude.Text ->
  UpdateDataSource
newUpdateDataSource :: Text -> Text -> UpdateDataSource
newUpdateDataSource Text
pId_ Text
pIndexId_ =
  UpdateDataSource'
    { $sel:configuration:UpdateDataSource' :: Maybe DataSourceConfiguration
configuration = forall a. Maybe a
Prelude.Nothing,
      $sel:customDocumentEnrichmentConfiguration:UpdateDataSource' :: Maybe CustomDocumentEnrichmentConfiguration
customDocumentEnrichmentConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdateDataSource' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:languageCode:UpdateDataSource' :: Maybe Text
languageCode = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateDataSource' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:roleArn:UpdateDataSource' :: Maybe Text
roleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:schedule:UpdateDataSource' :: Maybe Text
schedule = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcConfiguration:UpdateDataSource' :: Maybe DataSourceVpcConfiguration
vpcConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:id:UpdateDataSource' :: Text
id = Text
pId_,
      $sel:indexId:UpdateDataSource' :: Text
indexId = Text
pIndexId_
    }

-- | Configuration information you want to update for the data source
-- connector.
updateDataSource_configuration :: Lens.Lens' UpdateDataSource (Prelude.Maybe DataSourceConfiguration)
updateDataSource_configuration :: Lens' UpdateDataSource (Maybe DataSourceConfiguration)
updateDataSource_configuration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDataSource' {Maybe DataSourceConfiguration
configuration :: Maybe DataSourceConfiguration
$sel:configuration:UpdateDataSource' :: UpdateDataSource -> Maybe DataSourceConfiguration
configuration} -> Maybe DataSourceConfiguration
configuration) (\s :: UpdateDataSource
s@UpdateDataSource' {} Maybe DataSourceConfiguration
a -> UpdateDataSource
s {$sel:configuration:UpdateDataSource' :: Maybe DataSourceConfiguration
configuration = Maybe DataSourceConfiguration
a} :: UpdateDataSource)

-- | Configuration information you want to update for altering document
-- metadata and content during the document ingestion process.
--
-- For more information on how to create, modify and delete document
-- metadata, or make other content alterations when you ingest documents
-- into Amazon Kendra, see
-- <https://docs.aws.amazon.com/kendra/latest/dg/custom-document-enrichment.html Customizing document metadata during the ingestion process>.
updateDataSource_customDocumentEnrichmentConfiguration :: Lens.Lens' UpdateDataSource (Prelude.Maybe CustomDocumentEnrichmentConfiguration)
updateDataSource_customDocumentEnrichmentConfiguration :: Lens'
  UpdateDataSource (Maybe CustomDocumentEnrichmentConfiguration)
updateDataSource_customDocumentEnrichmentConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDataSource' {Maybe CustomDocumentEnrichmentConfiguration
customDocumentEnrichmentConfiguration :: Maybe CustomDocumentEnrichmentConfiguration
$sel:customDocumentEnrichmentConfiguration:UpdateDataSource' :: UpdateDataSource -> Maybe CustomDocumentEnrichmentConfiguration
customDocumentEnrichmentConfiguration} -> Maybe CustomDocumentEnrichmentConfiguration
customDocumentEnrichmentConfiguration) (\s :: UpdateDataSource
s@UpdateDataSource' {} Maybe CustomDocumentEnrichmentConfiguration
a -> UpdateDataSource
s {$sel:customDocumentEnrichmentConfiguration:UpdateDataSource' :: Maybe CustomDocumentEnrichmentConfiguration
customDocumentEnrichmentConfiguration = Maybe CustomDocumentEnrichmentConfiguration
a} :: UpdateDataSource)

-- | A new description for the data source connector.
updateDataSource_description :: Lens.Lens' UpdateDataSource (Prelude.Maybe Prelude.Text)
updateDataSource_description :: Lens' UpdateDataSource (Maybe Text)
updateDataSource_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDataSource' {Maybe Text
description :: Maybe Text
$sel:description:UpdateDataSource' :: UpdateDataSource -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateDataSource
s@UpdateDataSource' {} Maybe Text
a -> UpdateDataSource
s {$sel:description:UpdateDataSource' :: Maybe Text
description = Maybe Text
a} :: UpdateDataSource)

-- | The code for a language you want to update for the data source
-- connector. This allows you to support a language for all documents when
-- updating the data source. English is supported by default. For more
-- information on supported languages, including their codes, see
-- <https://docs.aws.amazon.com/kendra/latest/dg/in-adding-languages.html Adding documents in languages other than English>.
updateDataSource_languageCode :: Lens.Lens' UpdateDataSource (Prelude.Maybe Prelude.Text)
updateDataSource_languageCode :: Lens' UpdateDataSource (Maybe Text)
updateDataSource_languageCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDataSource' {Maybe Text
languageCode :: Maybe Text
$sel:languageCode:UpdateDataSource' :: UpdateDataSource -> Maybe Text
languageCode} -> Maybe Text
languageCode) (\s :: UpdateDataSource
s@UpdateDataSource' {} Maybe Text
a -> UpdateDataSource
s {$sel:languageCode:UpdateDataSource' :: Maybe Text
languageCode = Maybe Text
a} :: UpdateDataSource)

-- | A new name for the data source connector.
updateDataSource_name :: Lens.Lens' UpdateDataSource (Prelude.Maybe Prelude.Text)
updateDataSource_name :: Lens' UpdateDataSource (Maybe Text)
updateDataSource_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDataSource' {Maybe Text
name :: Maybe Text
$sel:name:UpdateDataSource' :: UpdateDataSource -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdateDataSource
s@UpdateDataSource' {} Maybe Text
a -> UpdateDataSource
s {$sel:name:UpdateDataSource' :: Maybe Text
name = Maybe Text
a} :: UpdateDataSource)

-- | The Amazon Resource Name (ARN) of a role with permission to access the
-- data source and required resources. For more information, see
-- <https://docs.aws.amazon.com/kendra/latest/dg/iam-roles.html IAM roles for Amazon Kendra>.
updateDataSource_roleArn :: Lens.Lens' UpdateDataSource (Prelude.Maybe Prelude.Text)
updateDataSource_roleArn :: Lens' UpdateDataSource (Maybe Text)
updateDataSource_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDataSource' {Maybe Text
roleArn :: Maybe Text
$sel:roleArn:UpdateDataSource' :: UpdateDataSource -> Maybe Text
roleArn} -> Maybe Text
roleArn) (\s :: UpdateDataSource
s@UpdateDataSource' {} Maybe Text
a -> UpdateDataSource
s {$sel:roleArn:UpdateDataSource' :: Maybe Text
roleArn = Maybe Text
a} :: UpdateDataSource)

-- | The sync schedule you want to update for the data source connector.
updateDataSource_schedule :: Lens.Lens' UpdateDataSource (Prelude.Maybe Prelude.Text)
updateDataSource_schedule :: Lens' UpdateDataSource (Maybe Text)
updateDataSource_schedule = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDataSource' {Maybe Text
schedule :: Maybe Text
$sel:schedule:UpdateDataSource' :: UpdateDataSource -> Maybe Text
schedule} -> Maybe Text
schedule) (\s :: UpdateDataSource
s@UpdateDataSource' {} Maybe Text
a -> UpdateDataSource
s {$sel:schedule:UpdateDataSource' :: Maybe Text
schedule = Maybe Text
a} :: UpdateDataSource)

-- | Configuration information for an Amazon Virtual Private Cloud to connect
-- to your data source. For more information, see
-- <https://docs.aws.amazon.com/kendra/latest/dg/vpc-configuration.html Configuring a VPC>.
updateDataSource_vpcConfiguration :: Lens.Lens' UpdateDataSource (Prelude.Maybe DataSourceVpcConfiguration)
updateDataSource_vpcConfiguration :: Lens' UpdateDataSource (Maybe DataSourceVpcConfiguration)
updateDataSource_vpcConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDataSource' {Maybe DataSourceVpcConfiguration
vpcConfiguration :: Maybe DataSourceVpcConfiguration
$sel:vpcConfiguration:UpdateDataSource' :: UpdateDataSource -> Maybe DataSourceVpcConfiguration
vpcConfiguration} -> Maybe DataSourceVpcConfiguration
vpcConfiguration) (\s :: UpdateDataSource
s@UpdateDataSource' {} Maybe DataSourceVpcConfiguration
a -> UpdateDataSource
s {$sel:vpcConfiguration:UpdateDataSource' :: Maybe DataSourceVpcConfiguration
vpcConfiguration = Maybe DataSourceVpcConfiguration
a} :: UpdateDataSource)

-- | The identifier of the data source connector you want to update.
updateDataSource_id :: Lens.Lens' UpdateDataSource Prelude.Text
updateDataSource_id :: Lens' UpdateDataSource Text
updateDataSource_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDataSource' {Text
id :: Text
$sel:id:UpdateDataSource' :: UpdateDataSource -> Text
id} -> Text
id) (\s :: UpdateDataSource
s@UpdateDataSource' {} Text
a -> UpdateDataSource
s {$sel:id:UpdateDataSource' :: Text
id = Text
a} :: UpdateDataSource)

-- | The identifier of the index used with the data source connector.
updateDataSource_indexId :: Lens.Lens' UpdateDataSource Prelude.Text
updateDataSource_indexId :: Lens' UpdateDataSource Text
updateDataSource_indexId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDataSource' {Text
indexId :: Text
$sel:indexId:UpdateDataSource' :: UpdateDataSource -> Text
indexId} -> Text
indexId) (\s :: UpdateDataSource
s@UpdateDataSource' {} Text
a -> UpdateDataSource
s {$sel:indexId:UpdateDataSource' :: Text
indexId = Text
a} :: UpdateDataSource)

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

instance Prelude.Hashable UpdateDataSource where
  hashWithSalt :: Int -> UpdateDataSource -> Int
hashWithSalt Int
_salt UpdateDataSource' {Maybe Text
Maybe DataSourceVpcConfiguration
Maybe CustomDocumentEnrichmentConfiguration
Maybe DataSourceConfiguration
Text
indexId :: Text
id :: Text
vpcConfiguration :: Maybe DataSourceVpcConfiguration
schedule :: Maybe Text
roleArn :: Maybe Text
name :: Maybe Text
languageCode :: Maybe Text
description :: Maybe Text
customDocumentEnrichmentConfiguration :: Maybe CustomDocumentEnrichmentConfiguration
configuration :: Maybe DataSourceConfiguration
$sel:indexId:UpdateDataSource' :: UpdateDataSource -> Text
$sel:id:UpdateDataSource' :: UpdateDataSource -> Text
$sel:vpcConfiguration:UpdateDataSource' :: UpdateDataSource -> Maybe DataSourceVpcConfiguration
$sel:schedule:UpdateDataSource' :: UpdateDataSource -> Maybe Text
$sel:roleArn:UpdateDataSource' :: UpdateDataSource -> Maybe Text
$sel:name:UpdateDataSource' :: UpdateDataSource -> Maybe Text
$sel:languageCode:UpdateDataSource' :: UpdateDataSource -> Maybe Text
$sel:description:UpdateDataSource' :: UpdateDataSource -> Maybe Text
$sel:customDocumentEnrichmentConfiguration:UpdateDataSource' :: UpdateDataSource -> Maybe CustomDocumentEnrichmentConfiguration
$sel:configuration:UpdateDataSource' :: UpdateDataSource -> Maybe DataSourceConfiguration
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DataSourceConfiguration
configuration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CustomDocumentEnrichmentConfiguration
customDocumentEnrichmentConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
languageCode
      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 Text
schedule
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DataSourceVpcConfiguration
vpcConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
indexId

instance Prelude.NFData UpdateDataSource where
  rnf :: UpdateDataSource -> ()
rnf UpdateDataSource' {Maybe Text
Maybe DataSourceVpcConfiguration
Maybe CustomDocumentEnrichmentConfiguration
Maybe DataSourceConfiguration
Text
indexId :: Text
id :: Text
vpcConfiguration :: Maybe DataSourceVpcConfiguration
schedule :: Maybe Text
roleArn :: Maybe Text
name :: Maybe Text
languageCode :: Maybe Text
description :: Maybe Text
customDocumentEnrichmentConfiguration :: Maybe CustomDocumentEnrichmentConfiguration
configuration :: Maybe DataSourceConfiguration
$sel:indexId:UpdateDataSource' :: UpdateDataSource -> Text
$sel:id:UpdateDataSource' :: UpdateDataSource -> Text
$sel:vpcConfiguration:UpdateDataSource' :: UpdateDataSource -> Maybe DataSourceVpcConfiguration
$sel:schedule:UpdateDataSource' :: UpdateDataSource -> Maybe Text
$sel:roleArn:UpdateDataSource' :: UpdateDataSource -> Maybe Text
$sel:name:UpdateDataSource' :: UpdateDataSource -> Maybe Text
$sel:languageCode:UpdateDataSource' :: UpdateDataSource -> Maybe Text
$sel:description:UpdateDataSource' :: UpdateDataSource -> Maybe Text
$sel:customDocumentEnrichmentConfiguration:UpdateDataSource' :: UpdateDataSource -> Maybe CustomDocumentEnrichmentConfiguration
$sel:configuration:UpdateDataSource' :: UpdateDataSource -> Maybe DataSourceConfiguration
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DataSourceConfiguration
configuration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CustomDocumentEnrichmentConfiguration
customDocumentEnrichmentConfiguration
      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 Text
languageCode
      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 Text
schedule
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DataSourceVpcConfiguration
vpcConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
indexId

instance Data.ToHeaders UpdateDataSource where
  toHeaders :: UpdateDataSource -> [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.UpdateDataSource" ::
                          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 UpdateDataSource where
  toJSON :: UpdateDataSource -> Value
toJSON UpdateDataSource' {Maybe Text
Maybe DataSourceVpcConfiguration
Maybe CustomDocumentEnrichmentConfiguration
Maybe DataSourceConfiguration
Text
indexId :: Text
id :: Text
vpcConfiguration :: Maybe DataSourceVpcConfiguration
schedule :: Maybe Text
roleArn :: Maybe Text
name :: Maybe Text
languageCode :: Maybe Text
description :: Maybe Text
customDocumentEnrichmentConfiguration :: Maybe CustomDocumentEnrichmentConfiguration
configuration :: Maybe DataSourceConfiguration
$sel:indexId:UpdateDataSource' :: UpdateDataSource -> Text
$sel:id:UpdateDataSource' :: UpdateDataSource -> Text
$sel:vpcConfiguration:UpdateDataSource' :: UpdateDataSource -> Maybe DataSourceVpcConfiguration
$sel:schedule:UpdateDataSource' :: UpdateDataSource -> Maybe Text
$sel:roleArn:UpdateDataSource' :: UpdateDataSource -> Maybe Text
$sel:name:UpdateDataSource' :: UpdateDataSource -> Maybe Text
$sel:languageCode:UpdateDataSource' :: UpdateDataSource -> Maybe Text
$sel:description:UpdateDataSource' :: UpdateDataSource -> Maybe Text
$sel:customDocumentEnrichmentConfiguration:UpdateDataSource' :: UpdateDataSource -> Maybe CustomDocumentEnrichmentConfiguration
$sel:configuration:UpdateDataSource' :: UpdateDataSource -> Maybe DataSourceConfiguration
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Configuration" 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 DataSourceConfiguration
configuration,
            (Key
"CustomDocumentEnrichmentConfiguration" 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 CustomDocumentEnrichmentConfiguration
customDocumentEnrichmentConfiguration,
            (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
"LanguageCode" 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
languageCode,
            (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
"Schedule" 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
schedule,
            (Key
"VpcConfiguration" 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 DataSourceVpcConfiguration
vpcConfiguration,
            forall a. a -> Maybe a
Prelude.Just (Key
"Id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
id),
            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 UpdateDataSource where
  toPath :: UpdateDataSource -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

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

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