{-# 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.BatchPutDocument
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds one or more documents to an index.
--
-- The @BatchPutDocument@ API enables you to ingest inline documents or a
-- set of documents stored in an Amazon S3 bucket. Use this API to ingest
-- your text and unstructured text into an index, add custom attributes to
-- the documents, and to attach an access control list to the documents
-- added to the index.
--
-- The documents are indexed asynchronously. You can see the progress of
-- the batch using Amazon Web Services CloudWatch. Any error messages
-- related to processing the batch are sent to your Amazon Web Services
-- CloudWatch log.
--
-- For an example of ingesting inline documents using Python and Java SDKs,
-- see
-- <https://docs.aws.amazon.com/kendra/latest/dg/in-adding-binary-doc.html Adding files directly to an index>.
module Amazonka.Kendra.BatchPutDocument
  ( -- * Creating a Request
    BatchPutDocument (..),
    newBatchPutDocument,

    -- * Request Lenses
    batchPutDocument_customDocumentEnrichmentConfiguration,
    batchPutDocument_roleArn,
    batchPutDocument_indexId,
    batchPutDocument_documents,

    -- * Destructuring the Response
    BatchPutDocumentResponse (..),
    newBatchPutDocumentResponse,

    -- * Response Lenses
    batchPutDocumentResponse_failedDocuments,
    batchPutDocumentResponse_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:/ 'newBatchPutDocument' smart constructor.
data BatchPutDocument = BatchPutDocument'
  { -- | Configuration information for altering your document metadata and
    -- content during the document ingestion process when you use the
    -- @BatchPutDocument@ API.
    --
    -- 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>.
    BatchPutDocument -> Maybe CustomDocumentEnrichmentConfiguration
customDocumentEnrichmentConfiguration :: Prelude.Maybe CustomDocumentEnrichmentConfiguration,
    -- | The Amazon Resource Name (ARN) of a role that is allowed to run the
    -- @BatchPutDocument@ API. For more information, see
    -- <https://docs.aws.amazon.com/kendra/latest/dg/iam-roles.html IAM Roles for Amazon Kendra>.
    BatchPutDocument -> Maybe Text
roleArn :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the index to add the documents to. You need to create
    -- the index first using the @CreateIndex@ API.
    BatchPutDocument -> Text
indexId :: Prelude.Text,
    -- | One or more documents to add to the index.
    --
    -- Documents have the following file size limits.
    --
    -- -   5 MB total size for inline documents
    --
    -- -   50 MB total size for files from an S3 bucket
    --
    -- -   5 MB extracted text for any file
    --
    -- For more information about file size and transaction per second quotas,
    -- see <https://docs.aws.amazon.com/kendra/latest/dg/quotas.html Quotas>.
    BatchPutDocument -> NonEmpty Document
documents :: Prelude.NonEmpty Document
  }
  deriving (BatchPutDocument -> BatchPutDocument -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchPutDocument -> BatchPutDocument -> Bool
$c/= :: BatchPutDocument -> BatchPutDocument -> Bool
== :: BatchPutDocument -> BatchPutDocument -> Bool
$c== :: BatchPutDocument -> BatchPutDocument -> Bool
Prelude.Eq, ReadPrec [BatchPutDocument]
ReadPrec BatchPutDocument
Int -> ReadS BatchPutDocument
ReadS [BatchPutDocument]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchPutDocument]
$creadListPrec :: ReadPrec [BatchPutDocument]
readPrec :: ReadPrec BatchPutDocument
$creadPrec :: ReadPrec BatchPutDocument
readList :: ReadS [BatchPutDocument]
$creadList :: ReadS [BatchPutDocument]
readsPrec :: Int -> ReadS BatchPutDocument
$creadsPrec :: Int -> ReadS BatchPutDocument
Prelude.Read, Int -> BatchPutDocument -> ShowS
[BatchPutDocument] -> ShowS
BatchPutDocument -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchPutDocument] -> ShowS
$cshowList :: [BatchPutDocument] -> ShowS
show :: BatchPutDocument -> String
$cshow :: BatchPutDocument -> String
showsPrec :: Int -> BatchPutDocument -> ShowS
$cshowsPrec :: Int -> BatchPutDocument -> ShowS
Prelude.Show, forall x. Rep BatchPutDocument x -> BatchPutDocument
forall x. BatchPutDocument -> Rep BatchPutDocument x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchPutDocument x -> BatchPutDocument
$cfrom :: forall x. BatchPutDocument -> Rep BatchPutDocument x
Prelude.Generic)

-- |
-- Create a value of 'BatchPutDocument' 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:
--
-- 'customDocumentEnrichmentConfiguration', 'batchPutDocument_customDocumentEnrichmentConfiguration' - Configuration information for altering your document metadata and
-- content during the document ingestion process when you use the
-- @BatchPutDocument@ API.
--
-- 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>.
--
-- 'roleArn', 'batchPutDocument_roleArn' - The Amazon Resource Name (ARN) of a role that is allowed to run the
-- @BatchPutDocument@ API. For more information, see
-- <https://docs.aws.amazon.com/kendra/latest/dg/iam-roles.html IAM Roles for Amazon Kendra>.
--
-- 'indexId', 'batchPutDocument_indexId' - The identifier of the index to add the documents to. You need to create
-- the index first using the @CreateIndex@ API.
--
-- 'documents', 'batchPutDocument_documents' - One or more documents to add to the index.
--
-- Documents have the following file size limits.
--
-- -   5 MB total size for inline documents
--
-- -   50 MB total size for files from an S3 bucket
--
-- -   5 MB extracted text for any file
--
-- For more information about file size and transaction per second quotas,
-- see <https://docs.aws.amazon.com/kendra/latest/dg/quotas.html Quotas>.
newBatchPutDocument ::
  -- | 'indexId'
  Prelude.Text ->
  -- | 'documents'
  Prelude.NonEmpty Document ->
  BatchPutDocument
newBatchPutDocument :: Text -> NonEmpty Document -> BatchPutDocument
newBatchPutDocument Text
pIndexId_ NonEmpty Document
pDocuments_ =
  BatchPutDocument'
    { $sel:customDocumentEnrichmentConfiguration:BatchPutDocument' :: Maybe CustomDocumentEnrichmentConfiguration
customDocumentEnrichmentConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:roleArn:BatchPutDocument' :: Maybe Text
roleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:indexId:BatchPutDocument' :: Text
indexId = Text
pIndexId_,
      $sel:documents:BatchPutDocument' :: NonEmpty Document
documents = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Document
pDocuments_
    }

-- | Configuration information for altering your document metadata and
-- content during the document ingestion process when you use the
-- @BatchPutDocument@ API.
--
-- 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>.
batchPutDocument_customDocumentEnrichmentConfiguration :: Lens.Lens' BatchPutDocument (Prelude.Maybe CustomDocumentEnrichmentConfiguration)
batchPutDocument_customDocumentEnrichmentConfiguration :: Lens'
  BatchPutDocument (Maybe CustomDocumentEnrichmentConfiguration)
batchPutDocument_customDocumentEnrichmentConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchPutDocument' {Maybe CustomDocumentEnrichmentConfiguration
customDocumentEnrichmentConfiguration :: Maybe CustomDocumentEnrichmentConfiguration
$sel:customDocumentEnrichmentConfiguration:BatchPutDocument' :: BatchPutDocument -> Maybe CustomDocumentEnrichmentConfiguration
customDocumentEnrichmentConfiguration} -> Maybe CustomDocumentEnrichmentConfiguration
customDocumentEnrichmentConfiguration) (\s :: BatchPutDocument
s@BatchPutDocument' {} Maybe CustomDocumentEnrichmentConfiguration
a -> BatchPutDocument
s {$sel:customDocumentEnrichmentConfiguration:BatchPutDocument' :: Maybe CustomDocumentEnrichmentConfiguration
customDocumentEnrichmentConfiguration = Maybe CustomDocumentEnrichmentConfiguration
a} :: BatchPutDocument)

-- | The Amazon Resource Name (ARN) of a role that is allowed to run the
-- @BatchPutDocument@ API. For more information, see
-- <https://docs.aws.amazon.com/kendra/latest/dg/iam-roles.html IAM Roles for Amazon Kendra>.
batchPutDocument_roleArn :: Lens.Lens' BatchPutDocument (Prelude.Maybe Prelude.Text)
batchPutDocument_roleArn :: Lens' BatchPutDocument (Maybe Text)
batchPutDocument_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchPutDocument' {Maybe Text
roleArn :: Maybe Text
$sel:roleArn:BatchPutDocument' :: BatchPutDocument -> Maybe Text
roleArn} -> Maybe Text
roleArn) (\s :: BatchPutDocument
s@BatchPutDocument' {} Maybe Text
a -> BatchPutDocument
s {$sel:roleArn:BatchPutDocument' :: Maybe Text
roleArn = Maybe Text
a} :: BatchPutDocument)

-- | The identifier of the index to add the documents to. You need to create
-- the index first using the @CreateIndex@ API.
batchPutDocument_indexId :: Lens.Lens' BatchPutDocument Prelude.Text
batchPutDocument_indexId :: Lens' BatchPutDocument Text
batchPutDocument_indexId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchPutDocument' {Text
indexId :: Text
$sel:indexId:BatchPutDocument' :: BatchPutDocument -> Text
indexId} -> Text
indexId) (\s :: BatchPutDocument
s@BatchPutDocument' {} Text
a -> BatchPutDocument
s {$sel:indexId:BatchPutDocument' :: Text
indexId = Text
a} :: BatchPutDocument)

-- | One or more documents to add to the index.
--
-- Documents have the following file size limits.
--
-- -   5 MB total size for inline documents
--
-- -   50 MB total size for files from an S3 bucket
--
-- -   5 MB extracted text for any file
--
-- For more information about file size and transaction per second quotas,
-- see <https://docs.aws.amazon.com/kendra/latest/dg/quotas.html Quotas>.
batchPutDocument_documents :: Lens.Lens' BatchPutDocument (Prelude.NonEmpty Document)
batchPutDocument_documents :: Lens' BatchPutDocument (NonEmpty Document)
batchPutDocument_documents = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchPutDocument' {NonEmpty Document
documents :: NonEmpty Document
$sel:documents:BatchPutDocument' :: BatchPutDocument -> NonEmpty Document
documents} -> NonEmpty Document
documents) (\s :: BatchPutDocument
s@BatchPutDocument' {} NonEmpty Document
a -> BatchPutDocument
s {$sel:documents:BatchPutDocument' :: NonEmpty Document
documents = NonEmpty Document
a} :: BatchPutDocument) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest BatchPutDocument where
  type
    AWSResponse BatchPutDocument =
      BatchPutDocumentResponse
  request :: (Service -> Service)
-> BatchPutDocument -> Request BatchPutDocument
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 BatchPutDocument
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse BatchPutDocument)))
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 [BatchPutDocumentResponseFailedDocument]
-> Int -> BatchPutDocumentResponse
BatchPutDocumentResponse'
            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
"FailedDocuments"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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 BatchPutDocument where
  hashWithSalt :: Int -> BatchPutDocument -> Int
hashWithSalt Int
_salt BatchPutDocument' {Maybe Text
Maybe CustomDocumentEnrichmentConfiguration
NonEmpty Document
Text
documents :: NonEmpty Document
indexId :: Text
roleArn :: Maybe Text
customDocumentEnrichmentConfiguration :: Maybe CustomDocumentEnrichmentConfiguration
$sel:documents:BatchPutDocument' :: BatchPutDocument -> NonEmpty Document
$sel:indexId:BatchPutDocument' :: BatchPutDocument -> Text
$sel:roleArn:BatchPutDocument' :: BatchPutDocument -> Maybe Text
$sel:customDocumentEnrichmentConfiguration:BatchPutDocument' :: BatchPutDocument -> Maybe CustomDocumentEnrichmentConfiguration
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CustomDocumentEnrichmentConfiguration
customDocumentEnrichmentConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
roleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
indexId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Document
documents

instance Prelude.NFData BatchPutDocument where
  rnf :: BatchPutDocument -> ()
rnf BatchPutDocument' {Maybe Text
Maybe CustomDocumentEnrichmentConfiguration
NonEmpty Document
Text
documents :: NonEmpty Document
indexId :: Text
roleArn :: Maybe Text
customDocumentEnrichmentConfiguration :: Maybe CustomDocumentEnrichmentConfiguration
$sel:documents:BatchPutDocument' :: BatchPutDocument -> NonEmpty Document
$sel:indexId:BatchPutDocument' :: BatchPutDocument -> Text
$sel:roleArn:BatchPutDocument' :: BatchPutDocument -> Maybe Text
$sel:customDocumentEnrichmentConfiguration:BatchPutDocument' :: BatchPutDocument -> Maybe CustomDocumentEnrichmentConfiguration
..} =
    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
roleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
indexId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Document
documents

instance Data.ToHeaders BatchPutDocument where
  toHeaders :: BatchPutDocument -> 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.BatchPutDocument" ::
                          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 BatchPutDocument where
  toJSON :: BatchPutDocument -> Value
toJSON BatchPutDocument' {Maybe Text
Maybe CustomDocumentEnrichmentConfiguration
NonEmpty Document
Text
documents :: NonEmpty Document
indexId :: Text
roleArn :: Maybe Text
customDocumentEnrichmentConfiguration :: Maybe CustomDocumentEnrichmentConfiguration
$sel:documents:BatchPutDocument' :: BatchPutDocument -> NonEmpty Document
$sel:indexId:BatchPutDocument' :: BatchPutDocument -> Text
$sel:roleArn:BatchPutDocument' :: BatchPutDocument -> Maybe Text
$sel:customDocumentEnrichmentConfiguration:BatchPutDocument' :: BatchPutDocument -> Maybe CustomDocumentEnrichmentConfiguration
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"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,
            forall a. a -> Maybe a
Prelude.Just (Key
"IndexId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
indexId),
            forall a. a -> Maybe a
Prelude.Just (Key
"Documents" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Document
documents)
          ]
      )

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

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

-- | /See:/ 'newBatchPutDocumentResponse' smart constructor.
data BatchPutDocumentResponse = BatchPutDocumentResponse'
  { -- | A list of documents that were not added to the index because the
    -- document failed a validation check. Each document contains an error
    -- message that indicates why the document couldn\'t be added to the index.
    --
    -- If there was an error adding a document to an index the error is
    -- reported in your Amazon Web Services CloudWatch log. For more
    -- information, see
    -- <https://docs.aws.amazon.com/kendra/latest/dg/cloudwatch-logs.html Monitoring Amazon Kendra with Amazon CloudWatch Logs>
    BatchPutDocumentResponse
-> Maybe [BatchPutDocumentResponseFailedDocument]
failedDocuments :: Prelude.Maybe [BatchPutDocumentResponseFailedDocument],
    -- | The response's http status code.
    BatchPutDocumentResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (BatchPutDocumentResponse -> BatchPutDocumentResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchPutDocumentResponse -> BatchPutDocumentResponse -> Bool
$c/= :: BatchPutDocumentResponse -> BatchPutDocumentResponse -> Bool
== :: BatchPutDocumentResponse -> BatchPutDocumentResponse -> Bool
$c== :: BatchPutDocumentResponse -> BatchPutDocumentResponse -> Bool
Prelude.Eq, ReadPrec [BatchPutDocumentResponse]
ReadPrec BatchPutDocumentResponse
Int -> ReadS BatchPutDocumentResponse
ReadS [BatchPutDocumentResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchPutDocumentResponse]
$creadListPrec :: ReadPrec [BatchPutDocumentResponse]
readPrec :: ReadPrec BatchPutDocumentResponse
$creadPrec :: ReadPrec BatchPutDocumentResponse
readList :: ReadS [BatchPutDocumentResponse]
$creadList :: ReadS [BatchPutDocumentResponse]
readsPrec :: Int -> ReadS BatchPutDocumentResponse
$creadsPrec :: Int -> ReadS BatchPutDocumentResponse
Prelude.Read, Int -> BatchPutDocumentResponse -> ShowS
[BatchPutDocumentResponse] -> ShowS
BatchPutDocumentResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchPutDocumentResponse] -> ShowS
$cshowList :: [BatchPutDocumentResponse] -> ShowS
show :: BatchPutDocumentResponse -> String
$cshow :: BatchPutDocumentResponse -> String
showsPrec :: Int -> BatchPutDocumentResponse -> ShowS
$cshowsPrec :: Int -> BatchPutDocumentResponse -> ShowS
Prelude.Show, forall x.
Rep BatchPutDocumentResponse x -> BatchPutDocumentResponse
forall x.
BatchPutDocumentResponse -> Rep BatchPutDocumentResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchPutDocumentResponse x -> BatchPutDocumentResponse
$cfrom :: forall x.
BatchPutDocumentResponse -> Rep BatchPutDocumentResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchPutDocumentResponse' 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:
--
-- 'failedDocuments', 'batchPutDocumentResponse_failedDocuments' - A list of documents that were not added to the index because the
-- document failed a validation check. Each document contains an error
-- message that indicates why the document couldn\'t be added to the index.
--
-- If there was an error adding a document to an index the error is
-- reported in your Amazon Web Services CloudWatch log. For more
-- information, see
-- <https://docs.aws.amazon.com/kendra/latest/dg/cloudwatch-logs.html Monitoring Amazon Kendra with Amazon CloudWatch Logs>
--
-- 'httpStatus', 'batchPutDocumentResponse_httpStatus' - The response's http status code.
newBatchPutDocumentResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchPutDocumentResponse
newBatchPutDocumentResponse :: Int -> BatchPutDocumentResponse
newBatchPutDocumentResponse Int
pHttpStatus_ =
  BatchPutDocumentResponse'
    { $sel:failedDocuments:BatchPutDocumentResponse' :: Maybe [BatchPutDocumentResponseFailedDocument]
failedDocuments =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BatchPutDocumentResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of documents that were not added to the index because the
-- document failed a validation check. Each document contains an error
-- message that indicates why the document couldn\'t be added to the index.
--
-- If there was an error adding a document to an index the error is
-- reported in your Amazon Web Services CloudWatch log. For more
-- information, see
-- <https://docs.aws.amazon.com/kendra/latest/dg/cloudwatch-logs.html Monitoring Amazon Kendra with Amazon CloudWatch Logs>
batchPutDocumentResponse_failedDocuments :: Lens.Lens' BatchPutDocumentResponse (Prelude.Maybe [BatchPutDocumentResponseFailedDocument])
batchPutDocumentResponse_failedDocuments :: Lens'
  BatchPutDocumentResponse
  (Maybe [BatchPutDocumentResponseFailedDocument])
batchPutDocumentResponse_failedDocuments = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchPutDocumentResponse' {Maybe [BatchPutDocumentResponseFailedDocument]
failedDocuments :: Maybe [BatchPutDocumentResponseFailedDocument]
$sel:failedDocuments:BatchPutDocumentResponse' :: BatchPutDocumentResponse
-> Maybe [BatchPutDocumentResponseFailedDocument]
failedDocuments} -> Maybe [BatchPutDocumentResponseFailedDocument]
failedDocuments) (\s :: BatchPutDocumentResponse
s@BatchPutDocumentResponse' {} Maybe [BatchPutDocumentResponseFailedDocument]
a -> BatchPutDocumentResponse
s {$sel:failedDocuments:BatchPutDocumentResponse' :: Maybe [BatchPutDocumentResponseFailedDocument]
failedDocuments = Maybe [BatchPutDocumentResponseFailedDocument]
a} :: BatchPutDocumentResponse) 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 response's http status code.
batchPutDocumentResponse_httpStatus :: Lens.Lens' BatchPutDocumentResponse Prelude.Int
batchPutDocumentResponse_httpStatus :: Lens' BatchPutDocumentResponse Int
batchPutDocumentResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchPutDocumentResponse' {Int
httpStatus :: Int
$sel:httpStatus:BatchPutDocumentResponse' :: BatchPutDocumentResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: BatchPutDocumentResponse
s@BatchPutDocumentResponse' {} Int
a -> BatchPutDocumentResponse
s {$sel:httpStatus:BatchPutDocumentResponse' :: Int
httpStatus = Int
a} :: BatchPutDocumentResponse)

instance Prelude.NFData BatchPutDocumentResponse where
  rnf :: BatchPutDocumentResponse -> ()
rnf BatchPutDocumentResponse' {Int
Maybe [BatchPutDocumentResponseFailedDocument]
httpStatus :: Int
failedDocuments :: Maybe [BatchPutDocumentResponseFailedDocument]
$sel:httpStatus:BatchPutDocumentResponse' :: BatchPutDocumentResponse -> Int
$sel:failedDocuments:BatchPutDocumentResponse' :: BatchPutDocumentResponse
-> Maybe [BatchPutDocumentResponseFailedDocument]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [BatchPutDocumentResponseFailedDocument]
failedDocuments
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus