{-# 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.Comprehend.DescribeDocumentClassificationJob
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets the properties associated with a document classification job. Use
-- this operation to get the status of a classification job.
module Amazonka.Comprehend.DescribeDocumentClassificationJob
  ( -- * Creating a Request
    DescribeDocumentClassificationJob (..),
    newDescribeDocumentClassificationJob,

    -- * Request Lenses
    describeDocumentClassificationJob_jobId,

    -- * Destructuring the Response
    DescribeDocumentClassificationJobResponse (..),
    newDescribeDocumentClassificationJobResponse,

    -- * Response Lenses
    describeDocumentClassificationJobResponse_documentClassificationJobProperties,
    describeDocumentClassificationJobResponse_httpStatus,
  )
where

import Amazonka.Comprehend.Types
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

-- | /See:/ 'newDescribeDocumentClassificationJob' smart constructor.
data DescribeDocumentClassificationJob = DescribeDocumentClassificationJob'
  { -- | The identifier that Amazon Comprehend generated for the job. The
    -- operation returns this identifier in its response.
    DescribeDocumentClassificationJob -> Text
jobId :: Prelude.Text
  }
  deriving (DescribeDocumentClassificationJob
-> DescribeDocumentClassificationJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeDocumentClassificationJob
-> DescribeDocumentClassificationJob -> Bool
$c/= :: DescribeDocumentClassificationJob
-> DescribeDocumentClassificationJob -> Bool
== :: DescribeDocumentClassificationJob
-> DescribeDocumentClassificationJob -> Bool
$c== :: DescribeDocumentClassificationJob
-> DescribeDocumentClassificationJob -> Bool
Prelude.Eq, ReadPrec [DescribeDocumentClassificationJob]
ReadPrec DescribeDocumentClassificationJob
Int -> ReadS DescribeDocumentClassificationJob
ReadS [DescribeDocumentClassificationJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeDocumentClassificationJob]
$creadListPrec :: ReadPrec [DescribeDocumentClassificationJob]
readPrec :: ReadPrec DescribeDocumentClassificationJob
$creadPrec :: ReadPrec DescribeDocumentClassificationJob
readList :: ReadS [DescribeDocumentClassificationJob]
$creadList :: ReadS [DescribeDocumentClassificationJob]
readsPrec :: Int -> ReadS DescribeDocumentClassificationJob
$creadsPrec :: Int -> ReadS DescribeDocumentClassificationJob
Prelude.Read, Int -> DescribeDocumentClassificationJob -> ShowS
[DescribeDocumentClassificationJob] -> ShowS
DescribeDocumentClassificationJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeDocumentClassificationJob] -> ShowS
$cshowList :: [DescribeDocumentClassificationJob] -> ShowS
show :: DescribeDocumentClassificationJob -> String
$cshow :: DescribeDocumentClassificationJob -> String
showsPrec :: Int -> DescribeDocumentClassificationJob -> ShowS
$cshowsPrec :: Int -> DescribeDocumentClassificationJob -> ShowS
Prelude.Show, forall x.
Rep DescribeDocumentClassificationJob x
-> DescribeDocumentClassificationJob
forall x.
DescribeDocumentClassificationJob
-> Rep DescribeDocumentClassificationJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeDocumentClassificationJob x
-> DescribeDocumentClassificationJob
$cfrom :: forall x.
DescribeDocumentClassificationJob
-> Rep DescribeDocumentClassificationJob x
Prelude.Generic)

-- |
-- Create a value of 'DescribeDocumentClassificationJob' 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', 'describeDocumentClassificationJob_jobId' - The identifier that Amazon Comprehend generated for the job. The
-- operation returns this identifier in its response.
newDescribeDocumentClassificationJob ::
  -- | 'jobId'
  Prelude.Text ->
  DescribeDocumentClassificationJob
newDescribeDocumentClassificationJob :: Text -> DescribeDocumentClassificationJob
newDescribeDocumentClassificationJob Text
pJobId_ =
  DescribeDocumentClassificationJob' {$sel:jobId:DescribeDocumentClassificationJob' :: Text
jobId = Text
pJobId_}

-- | The identifier that Amazon Comprehend generated for the job. The
-- operation returns this identifier in its response.
describeDocumentClassificationJob_jobId :: Lens.Lens' DescribeDocumentClassificationJob Prelude.Text
describeDocumentClassificationJob_jobId :: Lens' DescribeDocumentClassificationJob Text
describeDocumentClassificationJob_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDocumentClassificationJob' {Text
jobId :: Text
$sel:jobId:DescribeDocumentClassificationJob' :: DescribeDocumentClassificationJob -> Text
jobId} -> Text
jobId) (\s :: DescribeDocumentClassificationJob
s@DescribeDocumentClassificationJob' {} Text
a -> DescribeDocumentClassificationJob
s {$sel:jobId:DescribeDocumentClassificationJob' :: Text
jobId = Text
a} :: DescribeDocumentClassificationJob)

instance
  Core.AWSRequest
    DescribeDocumentClassificationJob
  where
  type
    AWSResponse DescribeDocumentClassificationJob =
      DescribeDocumentClassificationJobResponse
  request :: (Service -> Service)
-> DescribeDocumentClassificationJob
-> Request DescribeDocumentClassificationJob
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 DescribeDocumentClassificationJob
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse DescribeDocumentClassificationJob)))
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 DocumentClassificationJobProperties
-> Int -> DescribeDocumentClassificationJobResponse
DescribeDocumentClassificationJobResponse'
            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
"DocumentClassificationJobProperties")
            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
    DescribeDocumentClassificationJob
  where
  hashWithSalt :: Int -> DescribeDocumentClassificationJob -> Int
hashWithSalt
    Int
_salt
    DescribeDocumentClassificationJob' {Text
jobId :: Text
$sel:jobId:DescribeDocumentClassificationJob' :: DescribeDocumentClassificationJob -> Text
..} =
      Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobId

instance
  Prelude.NFData
    DescribeDocumentClassificationJob
  where
  rnf :: DescribeDocumentClassificationJob -> ()
rnf DescribeDocumentClassificationJob' {Text
jobId :: Text
$sel:jobId:DescribeDocumentClassificationJob' :: DescribeDocumentClassificationJob -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
jobId

instance
  Data.ToHeaders
    DescribeDocumentClassificationJob
  where
  toHeaders :: DescribeDocumentClassificationJob -> 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
"Comprehend_20171127.DescribeDocumentClassificationJob" ::
                          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
    DescribeDocumentClassificationJob
  where
  toJSON :: DescribeDocumentClassificationJob -> Value
toJSON DescribeDocumentClassificationJob' {Text
jobId :: Text
$sel:jobId:DescribeDocumentClassificationJob' :: DescribeDocumentClassificationJob -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"JobId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
jobId)]
      )

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

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

-- | /See:/ 'newDescribeDocumentClassificationJobResponse' smart constructor.
data DescribeDocumentClassificationJobResponse = DescribeDocumentClassificationJobResponse'
  { -- | An object that describes the properties associated with the document
    -- classification job.
    DescribeDocumentClassificationJobResponse
-> Maybe DocumentClassificationJobProperties
documentClassificationJobProperties :: Prelude.Maybe DocumentClassificationJobProperties,
    -- | The response's http status code.
    DescribeDocumentClassificationJobResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeDocumentClassificationJobResponse
-> DescribeDocumentClassificationJobResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeDocumentClassificationJobResponse
-> DescribeDocumentClassificationJobResponse -> Bool
$c/= :: DescribeDocumentClassificationJobResponse
-> DescribeDocumentClassificationJobResponse -> Bool
== :: DescribeDocumentClassificationJobResponse
-> DescribeDocumentClassificationJobResponse -> Bool
$c== :: DescribeDocumentClassificationJobResponse
-> DescribeDocumentClassificationJobResponse -> Bool
Prelude.Eq, ReadPrec [DescribeDocumentClassificationJobResponse]
ReadPrec DescribeDocumentClassificationJobResponse
Int -> ReadS DescribeDocumentClassificationJobResponse
ReadS [DescribeDocumentClassificationJobResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeDocumentClassificationJobResponse]
$creadListPrec :: ReadPrec [DescribeDocumentClassificationJobResponse]
readPrec :: ReadPrec DescribeDocumentClassificationJobResponse
$creadPrec :: ReadPrec DescribeDocumentClassificationJobResponse
readList :: ReadS [DescribeDocumentClassificationJobResponse]
$creadList :: ReadS [DescribeDocumentClassificationJobResponse]
readsPrec :: Int -> ReadS DescribeDocumentClassificationJobResponse
$creadsPrec :: Int -> ReadS DescribeDocumentClassificationJobResponse
Prelude.Read, Int -> DescribeDocumentClassificationJobResponse -> ShowS
[DescribeDocumentClassificationJobResponse] -> ShowS
DescribeDocumentClassificationJobResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeDocumentClassificationJobResponse] -> ShowS
$cshowList :: [DescribeDocumentClassificationJobResponse] -> ShowS
show :: DescribeDocumentClassificationJobResponse -> String
$cshow :: DescribeDocumentClassificationJobResponse -> String
showsPrec :: Int -> DescribeDocumentClassificationJobResponse -> ShowS
$cshowsPrec :: Int -> DescribeDocumentClassificationJobResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeDocumentClassificationJobResponse x
-> DescribeDocumentClassificationJobResponse
forall x.
DescribeDocumentClassificationJobResponse
-> Rep DescribeDocumentClassificationJobResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeDocumentClassificationJobResponse x
-> DescribeDocumentClassificationJobResponse
$cfrom :: forall x.
DescribeDocumentClassificationJobResponse
-> Rep DescribeDocumentClassificationJobResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeDocumentClassificationJobResponse' 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:
--
-- 'documentClassificationJobProperties', 'describeDocumentClassificationJobResponse_documentClassificationJobProperties' - An object that describes the properties associated with the document
-- classification job.
--
-- 'httpStatus', 'describeDocumentClassificationJobResponse_httpStatus' - The response's http status code.
newDescribeDocumentClassificationJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeDocumentClassificationJobResponse
newDescribeDocumentClassificationJobResponse :: Int -> DescribeDocumentClassificationJobResponse
newDescribeDocumentClassificationJobResponse
  Int
pHttpStatus_ =
    DescribeDocumentClassificationJobResponse'
      { $sel:documentClassificationJobProperties:DescribeDocumentClassificationJobResponse' :: Maybe DocumentClassificationJobProperties
documentClassificationJobProperties =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DescribeDocumentClassificationJobResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | An object that describes the properties associated with the document
-- classification job.
describeDocumentClassificationJobResponse_documentClassificationJobProperties :: Lens.Lens' DescribeDocumentClassificationJobResponse (Prelude.Maybe DocumentClassificationJobProperties)
describeDocumentClassificationJobResponse_documentClassificationJobProperties :: Lens'
  DescribeDocumentClassificationJobResponse
  (Maybe DocumentClassificationJobProperties)
describeDocumentClassificationJobResponse_documentClassificationJobProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeDocumentClassificationJobResponse' {Maybe DocumentClassificationJobProperties
documentClassificationJobProperties :: Maybe DocumentClassificationJobProperties
$sel:documentClassificationJobProperties:DescribeDocumentClassificationJobResponse' :: DescribeDocumentClassificationJobResponse
-> Maybe DocumentClassificationJobProperties
documentClassificationJobProperties} -> Maybe DocumentClassificationJobProperties
documentClassificationJobProperties) (\s :: DescribeDocumentClassificationJobResponse
s@DescribeDocumentClassificationJobResponse' {} Maybe DocumentClassificationJobProperties
a -> DescribeDocumentClassificationJobResponse
s {$sel:documentClassificationJobProperties:DescribeDocumentClassificationJobResponse' :: Maybe DocumentClassificationJobProperties
documentClassificationJobProperties = Maybe DocumentClassificationJobProperties
a} :: DescribeDocumentClassificationJobResponse)

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

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