{-# 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.Textract.StartLendingAnalysis
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Starts the classification and analysis of an input document.
-- @StartLendingAnalysis@ initiates the classification and analysis of a
-- packet of lending documents. @StartLendingAnalysis@ operates on a
-- document file located in an Amazon S3 bucket.
--
-- @StartLendingAnalysis@ can analyze text in documents that are in one of
-- the following formats: JPEG, PNG, TIFF, PDF. Use @DocumentLocation@ to
-- specify the bucket name and the file name of the document.
--
-- @StartLendingAnalysis@ returns a job identifier (@JobId@) that you use
-- to get the results of the operation. When the text analysis is finished,
-- Amazon Textract publishes a completion status to the Amazon Simple
-- Notification Service (Amazon SNS) topic that you specify in
-- @NotificationChannel@. To get the results of the text analysis
-- operation, first check that the status value published to the Amazon SNS
-- topic is SUCCEEDED. If the status is SUCCEEDED you can call either
-- @GetLendingAnalysis@ or @GetLendingAnalysisSummary@ and provide the
-- @JobId@ to obtain the results of the analysis.
--
-- If using @OutputConfig@ to specify an Amazon S3 bucket, the output will
-- be contained within the specified prefix in a directory labeled with the
-- job-id. In the directory there are 3 sub-directories:
--
-- -   detailedResponse (contains the GetLendingAnalysis response)
--
-- -   summaryResponse (for the GetLendingAnalysisSummary response)
--
-- -   splitDocuments (documents split across logical boundaries)
module Amazonka.Textract.StartLendingAnalysis
  ( -- * Creating a Request
    StartLendingAnalysis (..),
    newStartLendingAnalysis,

    -- * Request Lenses
    startLendingAnalysis_clientRequestToken,
    startLendingAnalysis_jobTag,
    startLendingAnalysis_kmsKeyId,
    startLendingAnalysis_notificationChannel,
    startLendingAnalysis_outputConfig,
    startLendingAnalysis_documentLocation,

    -- * Destructuring the Response
    StartLendingAnalysisResponse (..),
    newStartLendingAnalysisResponse,

    -- * Response Lenses
    startLendingAnalysisResponse_jobId,
    startLendingAnalysisResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.Textract.Types

-- | /See:/ 'newStartLendingAnalysis' smart constructor.
data StartLendingAnalysis = StartLendingAnalysis'
  { -- | The idempotent token that you use to identify the start request. If you
    -- use the same token with multiple @StartLendingAnalysis@ requests, the
    -- same @JobId@ is returned. Use @ClientRequestToken@ to prevent the same
    -- job from being accidentally started more than once. For more
    -- information, see
    -- <https://docs.aws.amazon.com/textract/latest/dg/api-sync.html Calling Amazon Textract Asynchronous Operations>.
    StartLendingAnalysis -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | An identifier that you specify to be included in the completion
    -- notification published to the Amazon SNS topic. For example, you can use
    -- @JobTag@ to identify the type of document that the completion
    -- notification corresponds to (such as a tax form or a receipt).
    StartLendingAnalysis -> Maybe Text
jobTag :: Prelude.Maybe Prelude.Text,
    -- | The KMS key used to encrypt the inference results. This can be in either
    -- Key ID or Key Alias format. When a KMS key is provided, the KMS key will
    -- be used for server-side encryption of the objects in the customer
    -- bucket. When this parameter is not enabled, the result will be encrypted
    -- server side, using SSE-S3.
    StartLendingAnalysis -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    StartLendingAnalysis -> Maybe NotificationChannel
notificationChannel :: Prelude.Maybe NotificationChannel,
    StartLendingAnalysis -> Maybe OutputConfig
outputConfig :: Prelude.Maybe OutputConfig,
    StartLendingAnalysis -> DocumentLocation
documentLocation :: DocumentLocation
  }
  deriving (StartLendingAnalysis -> StartLendingAnalysis -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartLendingAnalysis -> StartLendingAnalysis -> Bool
$c/= :: StartLendingAnalysis -> StartLendingAnalysis -> Bool
== :: StartLendingAnalysis -> StartLendingAnalysis -> Bool
$c== :: StartLendingAnalysis -> StartLendingAnalysis -> Bool
Prelude.Eq, ReadPrec [StartLendingAnalysis]
ReadPrec StartLendingAnalysis
Int -> ReadS StartLendingAnalysis
ReadS [StartLendingAnalysis]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartLendingAnalysis]
$creadListPrec :: ReadPrec [StartLendingAnalysis]
readPrec :: ReadPrec StartLendingAnalysis
$creadPrec :: ReadPrec StartLendingAnalysis
readList :: ReadS [StartLendingAnalysis]
$creadList :: ReadS [StartLendingAnalysis]
readsPrec :: Int -> ReadS StartLendingAnalysis
$creadsPrec :: Int -> ReadS StartLendingAnalysis
Prelude.Read, Int -> StartLendingAnalysis -> ShowS
[StartLendingAnalysis] -> ShowS
StartLendingAnalysis -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartLendingAnalysis] -> ShowS
$cshowList :: [StartLendingAnalysis] -> ShowS
show :: StartLendingAnalysis -> String
$cshow :: StartLendingAnalysis -> String
showsPrec :: Int -> StartLendingAnalysis -> ShowS
$cshowsPrec :: Int -> StartLendingAnalysis -> ShowS
Prelude.Show, forall x. Rep StartLendingAnalysis x -> StartLendingAnalysis
forall x. StartLendingAnalysis -> Rep StartLendingAnalysis x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartLendingAnalysis x -> StartLendingAnalysis
$cfrom :: forall x. StartLendingAnalysis -> Rep StartLendingAnalysis x
Prelude.Generic)

-- |
-- Create a value of 'StartLendingAnalysis' 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:
--
-- 'clientRequestToken', 'startLendingAnalysis_clientRequestToken' - The idempotent token that you use to identify the start request. If you
-- use the same token with multiple @StartLendingAnalysis@ requests, the
-- same @JobId@ is returned. Use @ClientRequestToken@ to prevent the same
-- job from being accidentally started more than once. For more
-- information, see
-- <https://docs.aws.amazon.com/textract/latest/dg/api-sync.html Calling Amazon Textract Asynchronous Operations>.
--
-- 'jobTag', 'startLendingAnalysis_jobTag' - An identifier that you specify to be included in the completion
-- notification published to the Amazon SNS topic. For example, you can use
-- @JobTag@ to identify the type of document that the completion
-- notification corresponds to (such as a tax form or a receipt).
--
-- 'kmsKeyId', 'startLendingAnalysis_kmsKeyId' - The KMS key used to encrypt the inference results. This can be in either
-- Key ID or Key Alias format. When a KMS key is provided, the KMS key will
-- be used for server-side encryption of the objects in the customer
-- bucket. When this parameter is not enabled, the result will be encrypted
-- server side, using SSE-S3.
--
-- 'notificationChannel', 'startLendingAnalysis_notificationChannel' - Undocumented member.
--
-- 'outputConfig', 'startLendingAnalysis_outputConfig' - Undocumented member.
--
-- 'documentLocation', 'startLendingAnalysis_documentLocation' - Undocumented member.
newStartLendingAnalysis ::
  -- | 'documentLocation'
  DocumentLocation ->
  StartLendingAnalysis
newStartLendingAnalysis :: DocumentLocation -> StartLendingAnalysis
newStartLendingAnalysis DocumentLocation
pDocumentLocation_ =
  StartLendingAnalysis'
    { $sel:clientRequestToken:StartLendingAnalysis' :: Maybe Text
clientRequestToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:jobTag:StartLendingAnalysis' :: Maybe Text
jobTag = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyId:StartLendingAnalysis' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:notificationChannel:StartLendingAnalysis' :: Maybe NotificationChannel
notificationChannel = forall a. Maybe a
Prelude.Nothing,
      $sel:outputConfig:StartLendingAnalysis' :: Maybe OutputConfig
outputConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:documentLocation:StartLendingAnalysis' :: DocumentLocation
documentLocation = DocumentLocation
pDocumentLocation_
    }

-- | The idempotent token that you use to identify the start request. If you
-- use the same token with multiple @StartLendingAnalysis@ requests, the
-- same @JobId@ is returned. Use @ClientRequestToken@ to prevent the same
-- job from being accidentally started more than once. For more
-- information, see
-- <https://docs.aws.amazon.com/textract/latest/dg/api-sync.html Calling Amazon Textract Asynchronous Operations>.
startLendingAnalysis_clientRequestToken :: Lens.Lens' StartLendingAnalysis (Prelude.Maybe Prelude.Text)
startLendingAnalysis_clientRequestToken :: Lens' StartLendingAnalysis (Maybe Text)
startLendingAnalysis_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartLendingAnalysis' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:StartLendingAnalysis' :: StartLendingAnalysis -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: StartLendingAnalysis
s@StartLendingAnalysis' {} Maybe Text
a -> StartLendingAnalysis
s {$sel:clientRequestToken:StartLendingAnalysis' :: Maybe Text
clientRequestToken = Maybe Text
a} :: StartLendingAnalysis)

-- | An identifier that you specify to be included in the completion
-- notification published to the Amazon SNS topic. For example, you can use
-- @JobTag@ to identify the type of document that the completion
-- notification corresponds to (such as a tax form or a receipt).
startLendingAnalysis_jobTag :: Lens.Lens' StartLendingAnalysis (Prelude.Maybe Prelude.Text)
startLendingAnalysis_jobTag :: Lens' StartLendingAnalysis (Maybe Text)
startLendingAnalysis_jobTag = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartLendingAnalysis' {Maybe Text
jobTag :: Maybe Text
$sel:jobTag:StartLendingAnalysis' :: StartLendingAnalysis -> Maybe Text
jobTag} -> Maybe Text
jobTag) (\s :: StartLendingAnalysis
s@StartLendingAnalysis' {} Maybe Text
a -> StartLendingAnalysis
s {$sel:jobTag:StartLendingAnalysis' :: Maybe Text
jobTag = Maybe Text
a} :: StartLendingAnalysis)

-- | The KMS key used to encrypt the inference results. This can be in either
-- Key ID or Key Alias format. When a KMS key is provided, the KMS key will
-- be used for server-side encryption of the objects in the customer
-- bucket. When this parameter is not enabled, the result will be encrypted
-- server side, using SSE-S3.
startLendingAnalysis_kmsKeyId :: Lens.Lens' StartLendingAnalysis (Prelude.Maybe Prelude.Text)
startLendingAnalysis_kmsKeyId :: Lens' StartLendingAnalysis (Maybe Text)
startLendingAnalysis_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartLendingAnalysis' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:StartLendingAnalysis' :: StartLendingAnalysis -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: StartLendingAnalysis
s@StartLendingAnalysis' {} Maybe Text
a -> StartLendingAnalysis
s {$sel:kmsKeyId:StartLendingAnalysis' :: Maybe Text
kmsKeyId = Maybe Text
a} :: StartLendingAnalysis)

-- | Undocumented member.
startLendingAnalysis_notificationChannel :: Lens.Lens' StartLendingAnalysis (Prelude.Maybe NotificationChannel)
startLendingAnalysis_notificationChannel :: Lens' StartLendingAnalysis (Maybe NotificationChannel)
startLendingAnalysis_notificationChannel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartLendingAnalysis' {Maybe NotificationChannel
notificationChannel :: Maybe NotificationChannel
$sel:notificationChannel:StartLendingAnalysis' :: StartLendingAnalysis -> Maybe NotificationChannel
notificationChannel} -> Maybe NotificationChannel
notificationChannel) (\s :: StartLendingAnalysis
s@StartLendingAnalysis' {} Maybe NotificationChannel
a -> StartLendingAnalysis
s {$sel:notificationChannel:StartLendingAnalysis' :: Maybe NotificationChannel
notificationChannel = Maybe NotificationChannel
a} :: StartLendingAnalysis)

-- | Undocumented member.
startLendingAnalysis_outputConfig :: Lens.Lens' StartLendingAnalysis (Prelude.Maybe OutputConfig)
startLendingAnalysis_outputConfig :: Lens' StartLendingAnalysis (Maybe OutputConfig)
startLendingAnalysis_outputConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartLendingAnalysis' {Maybe OutputConfig
outputConfig :: Maybe OutputConfig
$sel:outputConfig:StartLendingAnalysis' :: StartLendingAnalysis -> Maybe OutputConfig
outputConfig} -> Maybe OutputConfig
outputConfig) (\s :: StartLendingAnalysis
s@StartLendingAnalysis' {} Maybe OutputConfig
a -> StartLendingAnalysis
s {$sel:outputConfig:StartLendingAnalysis' :: Maybe OutputConfig
outputConfig = Maybe OutputConfig
a} :: StartLendingAnalysis)

-- | Undocumented member.
startLendingAnalysis_documentLocation :: Lens.Lens' StartLendingAnalysis DocumentLocation
startLendingAnalysis_documentLocation :: Lens' StartLendingAnalysis DocumentLocation
startLendingAnalysis_documentLocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartLendingAnalysis' {DocumentLocation
documentLocation :: DocumentLocation
$sel:documentLocation:StartLendingAnalysis' :: StartLendingAnalysis -> DocumentLocation
documentLocation} -> DocumentLocation
documentLocation) (\s :: StartLendingAnalysis
s@StartLendingAnalysis' {} DocumentLocation
a -> StartLendingAnalysis
s {$sel:documentLocation:StartLendingAnalysis' :: DocumentLocation
documentLocation = DocumentLocation
a} :: StartLendingAnalysis)

instance Core.AWSRequest StartLendingAnalysis where
  type
    AWSResponse StartLendingAnalysis =
      StartLendingAnalysisResponse
  request :: (Service -> Service)
-> StartLendingAnalysis -> Request StartLendingAnalysis
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 StartLendingAnalysis
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartLendingAnalysis)))
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 -> StartLendingAnalysisResponse
StartLendingAnalysisResponse'
            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
"JobId")
            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 StartLendingAnalysis where
  hashWithSalt :: Int -> StartLendingAnalysis -> Int
hashWithSalt Int
_salt StartLendingAnalysis' {Maybe Text
Maybe NotificationChannel
Maybe OutputConfig
DocumentLocation
documentLocation :: DocumentLocation
outputConfig :: Maybe OutputConfig
notificationChannel :: Maybe NotificationChannel
kmsKeyId :: Maybe Text
jobTag :: Maybe Text
clientRequestToken :: Maybe Text
$sel:documentLocation:StartLendingAnalysis' :: StartLendingAnalysis -> DocumentLocation
$sel:outputConfig:StartLendingAnalysis' :: StartLendingAnalysis -> Maybe OutputConfig
$sel:notificationChannel:StartLendingAnalysis' :: StartLendingAnalysis -> Maybe NotificationChannel
$sel:kmsKeyId:StartLendingAnalysis' :: StartLendingAnalysis -> Maybe Text
$sel:jobTag:StartLendingAnalysis' :: StartLendingAnalysis -> Maybe Text
$sel:clientRequestToken:StartLendingAnalysis' :: StartLendingAnalysis -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
jobTag
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe NotificationChannel
notificationChannel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OutputConfig
outputConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DocumentLocation
documentLocation

instance Prelude.NFData StartLendingAnalysis where
  rnf :: StartLendingAnalysis -> ()
rnf StartLendingAnalysis' {Maybe Text
Maybe NotificationChannel
Maybe OutputConfig
DocumentLocation
documentLocation :: DocumentLocation
outputConfig :: Maybe OutputConfig
notificationChannel :: Maybe NotificationChannel
kmsKeyId :: Maybe Text
jobTag :: Maybe Text
clientRequestToken :: Maybe Text
$sel:documentLocation:StartLendingAnalysis' :: StartLendingAnalysis -> DocumentLocation
$sel:outputConfig:StartLendingAnalysis' :: StartLendingAnalysis -> Maybe OutputConfig
$sel:notificationChannel:StartLendingAnalysis' :: StartLendingAnalysis -> Maybe NotificationChannel
$sel:kmsKeyId:StartLendingAnalysis' :: StartLendingAnalysis -> Maybe Text
$sel:jobTag:StartLendingAnalysis' :: StartLendingAnalysis -> Maybe Text
$sel:clientRequestToken:StartLendingAnalysis' :: StartLendingAnalysis -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientRequestToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
jobTag
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe NotificationChannel
notificationChannel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OutputConfig
outputConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DocumentLocation
documentLocation

instance Data.ToHeaders StartLendingAnalysis where
  toHeaders :: StartLendingAnalysis -> 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
"Textract.StartLendingAnalysis" ::
                          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 StartLendingAnalysis where
  toJSON :: StartLendingAnalysis -> Value
toJSON StartLendingAnalysis' {Maybe Text
Maybe NotificationChannel
Maybe OutputConfig
DocumentLocation
documentLocation :: DocumentLocation
outputConfig :: Maybe OutputConfig
notificationChannel :: Maybe NotificationChannel
kmsKeyId :: Maybe Text
jobTag :: Maybe Text
clientRequestToken :: Maybe Text
$sel:documentLocation:StartLendingAnalysis' :: StartLendingAnalysis -> DocumentLocation
$sel:outputConfig:StartLendingAnalysis' :: StartLendingAnalysis -> Maybe OutputConfig
$sel:notificationChannel:StartLendingAnalysis' :: StartLendingAnalysis -> Maybe NotificationChannel
$sel:kmsKeyId:StartLendingAnalysis' :: StartLendingAnalysis -> Maybe Text
$sel:jobTag:StartLendingAnalysis' :: StartLendingAnalysis -> Maybe Text
$sel:clientRequestToken:StartLendingAnalysis' :: StartLendingAnalysis -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientRequestToken" 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
clientRequestToken,
            (Key
"JobTag" 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
jobTag,
            (Key
"KMSKeyId" 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
kmsKeyId,
            (Key
"NotificationChannel" 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 NotificationChannel
notificationChannel,
            (Key
"OutputConfig" 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 OutputConfig
outputConfig,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"DocumentLocation" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= DocumentLocation
documentLocation)
          ]
      )

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

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

-- | /See:/ 'newStartLendingAnalysisResponse' smart constructor.
data StartLendingAnalysisResponse = StartLendingAnalysisResponse'
  { -- | A unique identifier for the lending or text-detection job. The @JobId@
    -- is returned from @StartLendingAnalysis@. A @JobId@ value is only valid
    -- for 7 days.
    StartLendingAnalysisResponse -> Maybe Text
jobId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    StartLendingAnalysisResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartLendingAnalysisResponse
-> StartLendingAnalysisResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartLendingAnalysisResponse
-> StartLendingAnalysisResponse -> Bool
$c/= :: StartLendingAnalysisResponse
-> StartLendingAnalysisResponse -> Bool
== :: StartLendingAnalysisResponse
-> StartLendingAnalysisResponse -> Bool
$c== :: StartLendingAnalysisResponse
-> StartLendingAnalysisResponse -> Bool
Prelude.Eq, ReadPrec [StartLendingAnalysisResponse]
ReadPrec StartLendingAnalysisResponse
Int -> ReadS StartLendingAnalysisResponse
ReadS [StartLendingAnalysisResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartLendingAnalysisResponse]
$creadListPrec :: ReadPrec [StartLendingAnalysisResponse]
readPrec :: ReadPrec StartLendingAnalysisResponse
$creadPrec :: ReadPrec StartLendingAnalysisResponse
readList :: ReadS [StartLendingAnalysisResponse]
$creadList :: ReadS [StartLendingAnalysisResponse]
readsPrec :: Int -> ReadS StartLendingAnalysisResponse
$creadsPrec :: Int -> ReadS StartLendingAnalysisResponse
Prelude.Read, Int -> StartLendingAnalysisResponse -> ShowS
[StartLendingAnalysisResponse] -> ShowS
StartLendingAnalysisResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartLendingAnalysisResponse] -> ShowS
$cshowList :: [StartLendingAnalysisResponse] -> ShowS
show :: StartLendingAnalysisResponse -> String
$cshow :: StartLendingAnalysisResponse -> String
showsPrec :: Int -> StartLendingAnalysisResponse -> ShowS
$cshowsPrec :: Int -> StartLendingAnalysisResponse -> ShowS
Prelude.Show, forall x.
Rep StartLendingAnalysisResponse x -> StartLendingAnalysisResponse
forall x.
StartLendingAnalysisResponse -> Rep StartLendingAnalysisResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartLendingAnalysisResponse x -> StartLendingAnalysisResponse
$cfrom :: forall x.
StartLendingAnalysisResponse -> Rep StartLendingAnalysisResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartLendingAnalysisResponse' 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:
--
-- 'jobId', 'startLendingAnalysisResponse_jobId' - A unique identifier for the lending or text-detection job. The @JobId@
-- is returned from @StartLendingAnalysis@. A @JobId@ value is only valid
-- for 7 days.
--
-- 'httpStatus', 'startLendingAnalysisResponse_httpStatus' - The response's http status code.
newStartLendingAnalysisResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartLendingAnalysisResponse
newStartLendingAnalysisResponse :: Int -> StartLendingAnalysisResponse
newStartLendingAnalysisResponse Int
pHttpStatus_ =
  StartLendingAnalysisResponse'
    { $sel:jobId:StartLendingAnalysisResponse' :: Maybe Text
jobId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartLendingAnalysisResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A unique identifier for the lending or text-detection job. The @JobId@
-- is returned from @StartLendingAnalysis@. A @JobId@ value is only valid
-- for 7 days.
startLendingAnalysisResponse_jobId :: Lens.Lens' StartLendingAnalysisResponse (Prelude.Maybe Prelude.Text)
startLendingAnalysisResponse_jobId :: Lens' StartLendingAnalysisResponse (Maybe Text)
startLendingAnalysisResponse_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartLendingAnalysisResponse' {Maybe Text
jobId :: Maybe Text
$sel:jobId:StartLendingAnalysisResponse' :: StartLendingAnalysisResponse -> Maybe Text
jobId} -> Maybe Text
jobId) (\s :: StartLendingAnalysisResponse
s@StartLendingAnalysisResponse' {} Maybe Text
a -> StartLendingAnalysisResponse
s {$sel:jobId:StartLendingAnalysisResponse' :: Maybe Text
jobId = Maybe Text
a} :: StartLendingAnalysisResponse)

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

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