{-# 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.BatchGetDocumentStatus
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the indexing status for one or more documents submitted with the
-- <https://docs.aws.amazon.com/kendra/latest/dg/API_BatchPutDocument.html BatchPutDocument>
-- API.
--
-- When you use the @BatchPutDocument@ API, documents are indexed
-- asynchronously. You can use the @BatchGetDocumentStatus@ API to get the
-- current status of a list of documents so that you can determine if they
-- have been successfully indexed.
--
-- You can also use the @BatchGetDocumentStatus@ API to check the status of
-- the
-- <https://docs.aws.amazon.com/kendra/latest/dg/API_BatchDeleteDocument.html BatchDeleteDocument>
-- API. When a document is deleted from the index, Amazon Kendra returns
-- @NOT_FOUND@ as the status.
module Amazonka.Kendra.BatchGetDocumentStatus
  ( -- * Creating a Request
    BatchGetDocumentStatus (..),
    newBatchGetDocumentStatus,

    -- * Request Lenses
    batchGetDocumentStatus_indexId,
    batchGetDocumentStatus_documentInfoList,

    -- * Destructuring the Response
    BatchGetDocumentStatusResponse (..),
    newBatchGetDocumentStatusResponse,

    -- * Response Lenses
    batchGetDocumentStatusResponse_documentStatusList,
    batchGetDocumentStatusResponse_errors,
    batchGetDocumentStatusResponse_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:/ 'newBatchGetDocumentStatus' smart constructor.
data BatchGetDocumentStatus = BatchGetDocumentStatus'
  { -- | The identifier of the index to add documents to. The index ID is
    -- returned by the
    -- <https://docs.aws.amazon.com/kendra/latest/dg/API_CreateIndex.html CreateIndex>
    -- API.
    BatchGetDocumentStatus -> Text
indexId :: Prelude.Text,
    -- | A list of @DocumentInfo@ objects that identify the documents for which
    -- to get the status. You identify the documents by their document ID and
    -- optional attributes.
    BatchGetDocumentStatus -> NonEmpty DocumentInfo
documentInfoList :: Prelude.NonEmpty DocumentInfo
  }
  deriving (BatchGetDocumentStatus -> BatchGetDocumentStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetDocumentStatus -> BatchGetDocumentStatus -> Bool
$c/= :: BatchGetDocumentStatus -> BatchGetDocumentStatus -> Bool
== :: BatchGetDocumentStatus -> BatchGetDocumentStatus -> Bool
$c== :: BatchGetDocumentStatus -> BatchGetDocumentStatus -> Bool
Prelude.Eq, ReadPrec [BatchGetDocumentStatus]
ReadPrec BatchGetDocumentStatus
Int -> ReadS BatchGetDocumentStatus
ReadS [BatchGetDocumentStatus]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetDocumentStatus]
$creadListPrec :: ReadPrec [BatchGetDocumentStatus]
readPrec :: ReadPrec BatchGetDocumentStatus
$creadPrec :: ReadPrec BatchGetDocumentStatus
readList :: ReadS [BatchGetDocumentStatus]
$creadList :: ReadS [BatchGetDocumentStatus]
readsPrec :: Int -> ReadS BatchGetDocumentStatus
$creadsPrec :: Int -> ReadS BatchGetDocumentStatus
Prelude.Read, Int -> BatchGetDocumentStatus -> ShowS
[BatchGetDocumentStatus] -> ShowS
BatchGetDocumentStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetDocumentStatus] -> ShowS
$cshowList :: [BatchGetDocumentStatus] -> ShowS
show :: BatchGetDocumentStatus -> String
$cshow :: BatchGetDocumentStatus -> String
showsPrec :: Int -> BatchGetDocumentStatus -> ShowS
$cshowsPrec :: Int -> BatchGetDocumentStatus -> ShowS
Prelude.Show, forall x. Rep BatchGetDocumentStatus x -> BatchGetDocumentStatus
forall x. BatchGetDocumentStatus -> Rep BatchGetDocumentStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchGetDocumentStatus x -> BatchGetDocumentStatus
$cfrom :: forall x. BatchGetDocumentStatus -> Rep BatchGetDocumentStatus x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetDocumentStatus' 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:
--
-- 'indexId', 'batchGetDocumentStatus_indexId' - The identifier of the index to add documents to. The index ID is
-- returned by the
-- <https://docs.aws.amazon.com/kendra/latest/dg/API_CreateIndex.html CreateIndex>
-- API.
--
-- 'documentInfoList', 'batchGetDocumentStatus_documentInfoList' - A list of @DocumentInfo@ objects that identify the documents for which
-- to get the status. You identify the documents by their document ID and
-- optional attributes.
newBatchGetDocumentStatus ::
  -- | 'indexId'
  Prelude.Text ->
  -- | 'documentInfoList'
  Prelude.NonEmpty DocumentInfo ->
  BatchGetDocumentStatus
newBatchGetDocumentStatus :: Text -> NonEmpty DocumentInfo -> BatchGetDocumentStatus
newBatchGetDocumentStatus
  Text
pIndexId_
  NonEmpty DocumentInfo
pDocumentInfoList_ =
    BatchGetDocumentStatus'
      { $sel:indexId:BatchGetDocumentStatus' :: Text
indexId = Text
pIndexId_,
        $sel:documentInfoList:BatchGetDocumentStatus' :: NonEmpty DocumentInfo
documentInfoList =
          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 DocumentInfo
pDocumentInfoList_
      }

-- | The identifier of the index to add documents to. The index ID is
-- returned by the
-- <https://docs.aws.amazon.com/kendra/latest/dg/API_CreateIndex.html CreateIndex>
-- API.
batchGetDocumentStatus_indexId :: Lens.Lens' BatchGetDocumentStatus Prelude.Text
batchGetDocumentStatus_indexId :: Lens' BatchGetDocumentStatus Text
batchGetDocumentStatus_indexId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetDocumentStatus' {Text
indexId :: Text
$sel:indexId:BatchGetDocumentStatus' :: BatchGetDocumentStatus -> Text
indexId} -> Text
indexId) (\s :: BatchGetDocumentStatus
s@BatchGetDocumentStatus' {} Text
a -> BatchGetDocumentStatus
s {$sel:indexId:BatchGetDocumentStatus' :: Text
indexId = Text
a} :: BatchGetDocumentStatus)

-- | A list of @DocumentInfo@ objects that identify the documents for which
-- to get the status. You identify the documents by their document ID and
-- optional attributes.
batchGetDocumentStatus_documentInfoList :: Lens.Lens' BatchGetDocumentStatus (Prelude.NonEmpty DocumentInfo)
batchGetDocumentStatus_documentInfoList :: Lens' BatchGetDocumentStatus (NonEmpty DocumentInfo)
batchGetDocumentStatus_documentInfoList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetDocumentStatus' {NonEmpty DocumentInfo
documentInfoList :: NonEmpty DocumentInfo
$sel:documentInfoList:BatchGetDocumentStatus' :: BatchGetDocumentStatus -> NonEmpty DocumentInfo
documentInfoList} -> NonEmpty DocumentInfo
documentInfoList) (\s :: BatchGetDocumentStatus
s@BatchGetDocumentStatus' {} NonEmpty DocumentInfo
a -> BatchGetDocumentStatus
s {$sel:documentInfoList:BatchGetDocumentStatus' :: NonEmpty DocumentInfo
documentInfoList = NonEmpty DocumentInfo
a} :: BatchGetDocumentStatus) 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 BatchGetDocumentStatus where
  type
    AWSResponse BatchGetDocumentStatus =
      BatchGetDocumentStatusResponse
  request :: (Service -> Service)
-> BatchGetDocumentStatus -> Request BatchGetDocumentStatus
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 BatchGetDocumentStatus
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchGetDocumentStatus)))
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 [Status]
-> Maybe [BatchGetDocumentStatusResponseError]
-> Int
-> BatchGetDocumentStatusResponse
BatchGetDocumentStatusResponse'
            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
"DocumentStatusList"
                            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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Errors" 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 BatchGetDocumentStatus where
  hashWithSalt :: Int -> BatchGetDocumentStatus -> Int
hashWithSalt Int
_salt BatchGetDocumentStatus' {NonEmpty DocumentInfo
Text
documentInfoList :: NonEmpty DocumentInfo
indexId :: Text
$sel:documentInfoList:BatchGetDocumentStatus' :: BatchGetDocumentStatus -> NonEmpty DocumentInfo
$sel:indexId:BatchGetDocumentStatus' :: BatchGetDocumentStatus -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
indexId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty DocumentInfo
documentInfoList

instance Prelude.NFData BatchGetDocumentStatus where
  rnf :: BatchGetDocumentStatus -> ()
rnf BatchGetDocumentStatus' {NonEmpty DocumentInfo
Text
documentInfoList :: NonEmpty DocumentInfo
indexId :: Text
$sel:documentInfoList:BatchGetDocumentStatus' :: BatchGetDocumentStatus -> NonEmpty DocumentInfo
$sel:indexId:BatchGetDocumentStatus' :: BatchGetDocumentStatus -> Text
..} =
    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 DocumentInfo
documentInfoList

instance Data.ToHeaders BatchGetDocumentStatus where
  toHeaders :: BatchGetDocumentStatus -> 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.BatchGetDocumentStatus" ::
                          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 BatchGetDocumentStatus where
  toJSON :: BatchGetDocumentStatus -> Value
toJSON BatchGetDocumentStatus' {NonEmpty DocumentInfo
Text
documentInfoList :: NonEmpty DocumentInfo
indexId :: Text
$sel:documentInfoList:BatchGetDocumentStatus' :: BatchGetDocumentStatus -> NonEmpty DocumentInfo
$sel:indexId:BatchGetDocumentStatus' :: BatchGetDocumentStatus -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ 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
"DocumentInfoList" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty DocumentInfo
documentInfoList)
          ]
      )

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

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

-- | /See:/ 'newBatchGetDocumentStatusResponse' smart constructor.
data BatchGetDocumentStatusResponse = BatchGetDocumentStatusResponse'
  { -- | The status of documents. The status indicates if the document is waiting
    -- to be indexed, is in the process of indexing, has completed indexing, or
    -- failed indexing. If a document failed indexing, the status provides the
    -- reason why.
    BatchGetDocumentStatusResponse -> Maybe [Status]
documentStatusList :: Prelude.Maybe [Status],
    -- | A list of documents that Amazon Kendra couldn\'t get the status for. The
    -- list includes the ID of the document and the reason that the status
    -- couldn\'t be found.
    BatchGetDocumentStatusResponse
-> Maybe [BatchGetDocumentStatusResponseError]
errors :: Prelude.Maybe [BatchGetDocumentStatusResponseError],
    -- | The response's http status code.
    BatchGetDocumentStatusResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (BatchGetDocumentStatusResponse
-> BatchGetDocumentStatusResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchGetDocumentStatusResponse
-> BatchGetDocumentStatusResponse -> Bool
$c/= :: BatchGetDocumentStatusResponse
-> BatchGetDocumentStatusResponse -> Bool
== :: BatchGetDocumentStatusResponse
-> BatchGetDocumentStatusResponse -> Bool
$c== :: BatchGetDocumentStatusResponse
-> BatchGetDocumentStatusResponse -> Bool
Prelude.Eq, ReadPrec [BatchGetDocumentStatusResponse]
ReadPrec BatchGetDocumentStatusResponse
Int -> ReadS BatchGetDocumentStatusResponse
ReadS [BatchGetDocumentStatusResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchGetDocumentStatusResponse]
$creadListPrec :: ReadPrec [BatchGetDocumentStatusResponse]
readPrec :: ReadPrec BatchGetDocumentStatusResponse
$creadPrec :: ReadPrec BatchGetDocumentStatusResponse
readList :: ReadS [BatchGetDocumentStatusResponse]
$creadList :: ReadS [BatchGetDocumentStatusResponse]
readsPrec :: Int -> ReadS BatchGetDocumentStatusResponse
$creadsPrec :: Int -> ReadS BatchGetDocumentStatusResponse
Prelude.Read, Int -> BatchGetDocumentStatusResponse -> ShowS
[BatchGetDocumentStatusResponse] -> ShowS
BatchGetDocumentStatusResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchGetDocumentStatusResponse] -> ShowS
$cshowList :: [BatchGetDocumentStatusResponse] -> ShowS
show :: BatchGetDocumentStatusResponse -> String
$cshow :: BatchGetDocumentStatusResponse -> String
showsPrec :: Int -> BatchGetDocumentStatusResponse -> ShowS
$cshowsPrec :: Int -> BatchGetDocumentStatusResponse -> ShowS
Prelude.Show, forall x.
Rep BatchGetDocumentStatusResponse x
-> BatchGetDocumentStatusResponse
forall x.
BatchGetDocumentStatusResponse
-> Rep BatchGetDocumentStatusResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchGetDocumentStatusResponse x
-> BatchGetDocumentStatusResponse
$cfrom :: forall x.
BatchGetDocumentStatusResponse
-> Rep BatchGetDocumentStatusResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchGetDocumentStatusResponse' 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:
--
-- 'documentStatusList', 'batchGetDocumentStatusResponse_documentStatusList' - The status of documents. The status indicates if the document is waiting
-- to be indexed, is in the process of indexing, has completed indexing, or
-- failed indexing. If a document failed indexing, the status provides the
-- reason why.
--
-- 'errors', 'batchGetDocumentStatusResponse_errors' - A list of documents that Amazon Kendra couldn\'t get the status for. The
-- list includes the ID of the document and the reason that the status
-- couldn\'t be found.
--
-- 'httpStatus', 'batchGetDocumentStatusResponse_httpStatus' - The response's http status code.
newBatchGetDocumentStatusResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchGetDocumentStatusResponse
newBatchGetDocumentStatusResponse :: Int -> BatchGetDocumentStatusResponse
newBatchGetDocumentStatusResponse Int
pHttpStatus_ =
  BatchGetDocumentStatusResponse'
    { $sel:documentStatusList:BatchGetDocumentStatusResponse' :: Maybe [Status]
documentStatusList =
        forall a. Maybe a
Prelude.Nothing,
      $sel:errors:BatchGetDocumentStatusResponse' :: Maybe [BatchGetDocumentStatusResponseError]
errors = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:BatchGetDocumentStatusResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The status of documents. The status indicates if the document is waiting
-- to be indexed, is in the process of indexing, has completed indexing, or
-- failed indexing. If a document failed indexing, the status provides the
-- reason why.
batchGetDocumentStatusResponse_documentStatusList :: Lens.Lens' BatchGetDocumentStatusResponse (Prelude.Maybe [Status])
batchGetDocumentStatusResponse_documentStatusList :: Lens' BatchGetDocumentStatusResponse (Maybe [Status])
batchGetDocumentStatusResponse_documentStatusList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetDocumentStatusResponse' {Maybe [Status]
documentStatusList :: Maybe [Status]
$sel:documentStatusList:BatchGetDocumentStatusResponse' :: BatchGetDocumentStatusResponse -> Maybe [Status]
documentStatusList} -> Maybe [Status]
documentStatusList) (\s :: BatchGetDocumentStatusResponse
s@BatchGetDocumentStatusResponse' {} Maybe [Status]
a -> BatchGetDocumentStatusResponse
s {$sel:documentStatusList:BatchGetDocumentStatusResponse' :: Maybe [Status]
documentStatusList = Maybe [Status]
a} :: BatchGetDocumentStatusResponse) 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 list of documents that Amazon Kendra couldn\'t get the status for. The
-- list includes the ID of the document and the reason that the status
-- couldn\'t be found.
batchGetDocumentStatusResponse_errors :: Lens.Lens' BatchGetDocumentStatusResponse (Prelude.Maybe [BatchGetDocumentStatusResponseError])
batchGetDocumentStatusResponse_errors :: Lens'
  BatchGetDocumentStatusResponse
  (Maybe [BatchGetDocumentStatusResponseError])
batchGetDocumentStatusResponse_errors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetDocumentStatusResponse' {Maybe [BatchGetDocumentStatusResponseError]
errors :: Maybe [BatchGetDocumentStatusResponseError]
$sel:errors:BatchGetDocumentStatusResponse' :: BatchGetDocumentStatusResponse
-> Maybe [BatchGetDocumentStatusResponseError]
errors} -> Maybe [BatchGetDocumentStatusResponseError]
errors) (\s :: BatchGetDocumentStatusResponse
s@BatchGetDocumentStatusResponse' {} Maybe [BatchGetDocumentStatusResponseError]
a -> BatchGetDocumentStatusResponse
s {$sel:errors:BatchGetDocumentStatusResponse' :: Maybe [BatchGetDocumentStatusResponseError]
errors = Maybe [BatchGetDocumentStatusResponseError]
a} :: BatchGetDocumentStatusResponse) 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.
batchGetDocumentStatusResponse_httpStatus :: Lens.Lens' BatchGetDocumentStatusResponse Prelude.Int
batchGetDocumentStatusResponse_httpStatus :: Lens' BatchGetDocumentStatusResponse Int
batchGetDocumentStatusResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchGetDocumentStatusResponse' {Int
httpStatus :: Int
$sel:httpStatus:BatchGetDocumentStatusResponse' :: BatchGetDocumentStatusResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: BatchGetDocumentStatusResponse
s@BatchGetDocumentStatusResponse' {} Int
a -> BatchGetDocumentStatusResponse
s {$sel:httpStatus:BatchGetDocumentStatusResponse' :: Int
httpStatus = Int
a} :: BatchGetDocumentStatusResponse)

instance
  Prelude.NFData
    BatchGetDocumentStatusResponse
  where
  rnf :: BatchGetDocumentStatusResponse -> ()
rnf BatchGetDocumentStatusResponse' {Int
Maybe [BatchGetDocumentStatusResponseError]
Maybe [Status]
httpStatus :: Int
errors :: Maybe [BatchGetDocumentStatusResponseError]
documentStatusList :: Maybe [Status]
$sel:httpStatus:BatchGetDocumentStatusResponse' :: BatchGetDocumentStatusResponse -> Int
$sel:errors:BatchGetDocumentStatusResponse' :: BatchGetDocumentStatusResponse
-> Maybe [BatchGetDocumentStatusResponseError]
$sel:documentStatusList:BatchGetDocumentStatusResponse' :: BatchGetDocumentStatusResponse -> Maybe [Status]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Status]
documentStatusList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [BatchGetDocumentStatusResponseError]
errors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus