{-# 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.SageMaker.DescribeLabelingJob
-- 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 information about a labeling job.
module Amazonka.SageMaker.DescribeLabelingJob
  ( -- * Creating a Request
    DescribeLabelingJob (..),
    newDescribeLabelingJob,

    -- * Request Lenses
    describeLabelingJob_labelingJobName,

    -- * Destructuring the Response
    DescribeLabelingJobResponse (..),
    newDescribeLabelingJobResponse,

    -- * Response Lenses
    describeLabelingJobResponse_failureReason,
    describeLabelingJobResponse_labelAttributeName,
    describeLabelingJobResponse_labelCategoryConfigS3Uri,
    describeLabelingJobResponse_labelingJobAlgorithmsConfig,
    describeLabelingJobResponse_labelingJobOutput,
    describeLabelingJobResponse_stoppingConditions,
    describeLabelingJobResponse_tags,
    describeLabelingJobResponse_httpStatus,
    describeLabelingJobResponse_labelingJobStatus,
    describeLabelingJobResponse_labelCounters,
    describeLabelingJobResponse_creationTime,
    describeLabelingJobResponse_lastModifiedTime,
    describeLabelingJobResponse_jobReferenceCode,
    describeLabelingJobResponse_labelingJobName,
    describeLabelingJobResponse_labelingJobArn,
    describeLabelingJobResponse_inputConfig,
    describeLabelingJobResponse_outputConfig,
    describeLabelingJobResponse_roleArn,
    describeLabelingJobResponse_humanTaskConfig,
  )
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.SageMaker.Types

-- | /See:/ 'newDescribeLabelingJob' smart constructor.
data DescribeLabelingJob = DescribeLabelingJob'
  { -- | The name of the labeling job to return information for.
    DescribeLabelingJob -> Text
labelingJobName :: Prelude.Text
  }
  deriving (DescribeLabelingJob -> DescribeLabelingJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeLabelingJob -> DescribeLabelingJob -> Bool
$c/= :: DescribeLabelingJob -> DescribeLabelingJob -> Bool
== :: DescribeLabelingJob -> DescribeLabelingJob -> Bool
$c== :: DescribeLabelingJob -> DescribeLabelingJob -> Bool
Prelude.Eq, ReadPrec [DescribeLabelingJob]
ReadPrec DescribeLabelingJob
Int -> ReadS DescribeLabelingJob
ReadS [DescribeLabelingJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeLabelingJob]
$creadListPrec :: ReadPrec [DescribeLabelingJob]
readPrec :: ReadPrec DescribeLabelingJob
$creadPrec :: ReadPrec DescribeLabelingJob
readList :: ReadS [DescribeLabelingJob]
$creadList :: ReadS [DescribeLabelingJob]
readsPrec :: Int -> ReadS DescribeLabelingJob
$creadsPrec :: Int -> ReadS DescribeLabelingJob
Prelude.Read, Int -> DescribeLabelingJob -> ShowS
[DescribeLabelingJob] -> ShowS
DescribeLabelingJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeLabelingJob] -> ShowS
$cshowList :: [DescribeLabelingJob] -> ShowS
show :: DescribeLabelingJob -> String
$cshow :: DescribeLabelingJob -> String
showsPrec :: Int -> DescribeLabelingJob -> ShowS
$cshowsPrec :: Int -> DescribeLabelingJob -> ShowS
Prelude.Show, forall x. Rep DescribeLabelingJob x -> DescribeLabelingJob
forall x. DescribeLabelingJob -> Rep DescribeLabelingJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeLabelingJob x -> DescribeLabelingJob
$cfrom :: forall x. DescribeLabelingJob -> Rep DescribeLabelingJob x
Prelude.Generic)

-- |
-- Create a value of 'DescribeLabelingJob' 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:
--
-- 'labelingJobName', 'describeLabelingJob_labelingJobName' - The name of the labeling job to return information for.
newDescribeLabelingJob ::
  -- | 'labelingJobName'
  Prelude.Text ->
  DescribeLabelingJob
newDescribeLabelingJob :: Text -> DescribeLabelingJob
newDescribeLabelingJob Text
pLabelingJobName_ =
  DescribeLabelingJob'
    { $sel:labelingJobName:DescribeLabelingJob' :: Text
labelingJobName =
        Text
pLabelingJobName_
    }

-- | The name of the labeling job to return information for.
describeLabelingJob_labelingJobName :: Lens.Lens' DescribeLabelingJob Prelude.Text
describeLabelingJob_labelingJobName :: Lens' DescribeLabelingJob Text
describeLabelingJob_labelingJobName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLabelingJob' {Text
labelingJobName :: Text
$sel:labelingJobName:DescribeLabelingJob' :: DescribeLabelingJob -> Text
labelingJobName} -> Text
labelingJobName) (\s :: DescribeLabelingJob
s@DescribeLabelingJob' {} Text
a -> DescribeLabelingJob
s {$sel:labelingJobName:DescribeLabelingJob' :: Text
labelingJobName = Text
a} :: DescribeLabelingJob)

instance Core.AWSRequest DescribeLabelingJob where
  type
    AWSResponse DescribeLabelingJob =
      DescribeLabelingJobResponse
  request :: (Service -> Service)
-> DescribeLabelingJob -> Request DescribeLabelingJob
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 DescribeLabelingJob
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeLabelingJob)))
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
-> Maybe Text
-> Maybe Text
-> Maybe LabelingJobAlgorithmsConfig
-> Maybe LabelingJobOutput
-> Maybe LabelingJobStoppingConditions
-> Maybe [Tag]
-> Int
-> LabelingJobStatus
-> LabelCounters
-> POSIX
-> POSIX
-> Text
-> Text
-> Text
-> LabelingJobInputConfig
-> LabelingJobOutputConfig
-> Text
-> HumanTaskConfig
-> DescribeLabelingJobResponse
DescribeLabelingJobResponse'
            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
"FailureReason")
            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
"LabelAttributeName")
            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
"LabelCategoryConfigS3Uri")
            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
"LabelingJobAlgorithmsConfig")
            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
"LabelingJobOutput")
            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
"StoppingConditions")
            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
"Tags" 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"LabelingJobStatus")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"LabelCounters")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"CreationTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"LastModifiedTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"JobReferenceCode")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"LabelingJobName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"LabelingJobArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"InputConfig")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"OutputConfig")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"RoleArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"HumanTaskConfig")
      )

instance Prelude.Hashable DescribeLabelingJob where
  hashWithSalt :: Int -> DescribeLabelingJob -> Int
hashWithSalt Int
_salt DescribeLabelingJob' {Text
labelingJobName :: Text
$sel:labelingJobName:DescribeLabelingJob' :: DescribeLabelingJob -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
labelingJobName

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

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

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

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

-- | /See:/ 'newDescribeLabelingJobResponse' smart constructor.
data DescribeLabelingJobResponse = DescribeLabelingJobResponse'
  { -- | If the job failed, the reason that it failed.
    DescribeLabelingJobResponse -> Maybe Text
failureReason :: Prelude.Maybe Prelude.Text,
    -- | The attribute used as the label in the output manifest file.
    DescribeLabelingJobResponse -> Maybe Text
labelAttributeName :: Prelude.Maybe Prelude.Text,
    -- | The S3 location of the JSON file that defines the categories used to
    -- label data objects. Please note the following label-category limits:
    --
    -- -   Semantic segmentation labeling jobs using automated labeling: 20
    --     labels
    --
    -- -   Box bounding labeling jobs (all): 10 labels
    --
    -- The file is a JSON structure in the following format:
    --
    -- @{@
    --
    -- @ \"document-version\": \"2018-11-28\"@
    --
    -- @ \"labels\": [@
    --
    -- @ {@
    --
    -- @ \"label\": \"@/@label 1@/@\"@
    --
    -- @ },@
    --
    -- @ {@
    --
    -- @ \"label\": \"@/@label 2@/@\"@
    --
    -- @ },@
    --
    -- @ ...@
    --
    -- @ {@
    --
    -- @ \"label\": \"@/@label n@/@\"@
    --
    -- @ }@
    --
    -- @ ]@
    --
    -- @}@
    DescribeLabelingJobResponse -> Maybe Text
labelCategoryConfigS3Uri :: Prelude.Maybe Prelude.Text,
    -- | Configuration information for automated data labeling.
    DescribeLabelingJobResponse -> Maybe LabelingJobAlgorithmsConfig
labelingJobAlgorithmsConfig :: Prelude.Maybe LabelingJobAlgorithmsConfig,
    -- | The location of the output produced by the labeling job.
    DescribeLabelingJobResponse -> Maybe LabelingJobOutput
labelingJobOutput :: Prelude.Maybe LabelingJobOutput,
    -- | A set of conditions for stopping a labeling job. If any of the
    -- conditions are met, the job is automatically stopped.
    DescribeLabelingJobResponse -> Maybe LabelingJobStoppingConditions
stoppingConditions :: Prelude.Maybe LabelingJobStoppingConditions,
    -- | An array of key-value pairs. You can use tags to categorize your Amazon
    -- Web Services resources in different ways, for example, by purpose,
    -- owner, or environment. For more information, see
    -- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services Resources>.
    DescribeLabelingJobResponse -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The response's http status code.
    DescribeLabelingJobResponse -> Int
httpStatus :: Prelude.Int,
    -- | The processing status of the labeling job.
    DescribeLabelingJobResponse -> LabelingJobStatus
labelingJobStatus :: LabelingJobStatus,
    -- | Provides a breakdown of the number of data objects labeled by humans,
    -- the number of objects labeled by machine, the number of objects than
    -- couldn\'t be labeled, and the total number of objects labeled.
    DescribeLabelingJobResponse -> LabelCounters
labelCounters :: LabelCounters,
    -- | The date and time that the labeling job was created.
    DescribeLabelingJobResponse -> POSIX
creationTime :: Data.POSIX,
    -- | The date and time that the labeling job was last updated.
    DescribeLabelingJobResponse -> POSIX
lastModifiedTime :: Data.POSIX,
    -- | A unique identifier for work done as part of a labeling job.
    DescribeLabelingJobResponse -> Text
jobReferenceCode :: Prelude.Text,
    -- | The name assigned to the labeling job when it was created.
    DescribeLabelingJobResponse -> Text
labelingJobName :: Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the labeling job.
    DescribeLabelingJobResponse -> Text
labelingJobArn :: Prelude.Text,
    -- | Input configuration information for the labeling job, such as the Amazon
    -- S3 location of the data objects and the location of the manifest file
    -- that describes the data objects.
    DescribeLabelingJobResponse -> LabelingJobInputConfig
inputConfig :: LabelingJobInputConfig,
    -- | The location of the job\'s output data and the Amazon Web Services Key
    -- Management Service key ID for the key used to encrypt the output data,
    -- if any.
    DescribeLabelingJobResponse -> LabelingJobOutputConfig
outputConfig :: LabelingJobOutputConfig,
    -- | The Amazon Resource Name (ARN) that SageMaker assumes to perform tasks
    -- on your behalf during data labeling.
    DescribeLabelingJobResponse -> Text
roleArn :: Prelude.Text,
    -- | Configuration information required for human workers to complete a
    -- labeling task.
    DescribeLabelingJobResponse -> HumanTaskConfig
humanTaskConfig :: HumanTaskConfig
  }
  deriving (DescribeLabelingJobResponse -> DescribeLabelingJobResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeLabelingJobResponse -> DescribeLabelingJobResponse -> Bool
$c/= :: DescribeLabelingJobResponse -> DescribeLabelingJobResponse -> Bool
== :: DescribeLabelingJobResponse -> DescribeLabelingJobResponse -> Bool
$c== :: DescribeLabelingJobResponse -> DescribeLabelingJobResponse -> Bool
Prelude.Eq, ReadPrec [DescribeLabelingJobResponse]
ReadPrec DescribeLabelingJobResponse
Int -> ReadS DescribeLabelingJobResponse
ReadS [DescribeLabelingJobResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeLabelingJobResponse]
$creadListPrec :: ReadPrec [DescribeLabelingJobResponse]
readPrec :: ReadPrec DescribeLabelingJobResponse
$creadPrec :: ReadPrec DescribeLabelingJobResponse
readList :: ReadS [DescribeLabelingJobResponse]
$creadList :: ReadS [DescribeLabelingJobResponse]
readsPrec :: Int -> ReadS DescribeLabelingJobResponse
$creadsPrec :: Int -> ReadS DescribeLabelingJobResponse
Prelude.Read, Int -> DescribeLabelingJobResponse -> ShowS
[DescribeLabelingJobResponse] -> ShowS
DescribeLabelingJobResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeLabelingJobResponse] -> ShowS
$cshowList :: [DescribeLabelingJobResponse] -> ShowS
show :: DescribeLabelingJobResponse -> String
$cshow :: DescribeLabelingJobResponse -> String
showsPrec :: Int -> DescribeLabelingJobResponse -> ShowS
$cshowsPrec :: Int -> DescribeLabelingJobResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeLabelingJobResponse x -> DescribeLabelingJobResponse
forall x.
DescribeLabelingJobResponse -> Rep DescribeLabelingJobResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeLabelingJobResponse x -> DescribeLabelingJobResponse
$cfrom :: forall x.
DescribeLabelingJobResponse -> Rep DescribeLabelingJobResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeLabelingJobResponse' 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:
--
-- 'failureReason', 'describeLabelingJobResponse_failureReason' - If the job failed, the reason that it failed.
--
-- 'labelAttributeName', 'describeLabelingJobResponse_labelAttributeName' - The attribute used as the label in the output manifest file.
--
-- 'labelCategoryConfigS3Uri', 'describeLabelingJobResponse_labelCategoryConfigS3Uri' - The S3 location of the JSON file that defines the categories used to
-- label data objects. Please note the following label-category limits:
--
-- -   Semantic segmentation labeling jobs using automated labeling: 20
--     labels
--
-- -   Box bounding labeling jobs (all): 10 labels
--
-- The file is a JSON structure in the following format:
--
-- @{@
--
-- @ \"document-version\": \"2018-11-28\"@
--
-- @ \"labels\": [@
--
-- @ {@
--
-- @ \"label\": \"@/@label 1@/@\"@
--
-- @ },@
--
-- @ {@
--
-- @ \"label\": \"@/@label 2@/@\"@
--
-- @ },@
--
-- @ ...@
--
-- @ {@
--
-- @ \"label\": \"@/@label n@/@\"@
--
-- @ }@
--
-- @ ]@
--
-- @}@
--
-- 'labelingJobAlgorithmsConfig', 'describeLabelingJobResponse_labelingJobAlgorithmsConfig' - Configuration information for automated data labeling.
--
-- 'labelingJobOutput', 'describeLabelingJobResponse_labelingJobOutput' - The location of the output produced by the labeling job.
--
-- 'stoppingConditions', 'describeLabelingJobResponse_stoppingConditions' - A set of conditions for stopping a labeling job. If any of the
-- conditions are met, the job is automatically stopped.
--
-- 'tags', 'describeLabelingJobResponse_tags' - An array of key-value pairs. You can use tags to categorize your Amazon
-- Web Services resources in different ways, for example, by purpose,
-- owner, or environment. For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services Resources>.
--
-- 'httpStatus', 'describeLabelingJobResponse_httpStatus' - The response's http status code.
--
-- 'labelingJobStatus', 'describeLabelingJobResponse_labelingJobStatus' - The processing status of the labeling job.
--
-- 'labelCounters', 'describeLabelingJobResponse_labelCounters' - Provides a breakdown of the number of data objects labeled by humans,
-- the number of objects labeled by machine, the number of objects than
-- couldn\'t be labeled, and the total number of objects labeled.
--
-- 'creationTime', 'describeLabelingJobResponse_creationTime' - The date and time that the labeling job was created.
--
-- 'lastModifiedTime', 'describeLabelingJobResponse_lastModifiedTime' - The date and time that the labeling job was last updated.
--
-- 'jobReferenceCode', 'describeLabelingJobResponse_jobReferenceCode' - A unique identifier for work done as part of a labeling job.
--
-- 'labelingJobName', 'describeLabelingJobResponse_labelingJobName' - The name assigned to the labeling job when it was created.
--
-- 'labelingJobArn', 'describeLabelingJobResponse_labelingJobArn' - The Amazon Resource Name (ARN) of the labeling job.
--
-- 'inputConfig', 'describeLabelingJobResponse_inputConfig' - Input configuration information for the labeling job, such as the Amazon
-- S3 location of the data objects and the location of the manifest file
-- that describes the data objects.
--
-- 'outputConfig', 'describeLabelingJobResponse_outputConfig' - The location of the job\'s output data and the Amazon Web Services Key
-- Management Service key ID for the key used to encrypt the output data,
-- if any.
--
-- 'roleArn', 'describeLabelingJobResponse_roleArn' - The Amazon Resource Name (ARN) that SageMaker assumes to perform tasks
-- on your behalf during data labeling.
--
-- 'humanTaskConfig', 'describeLabelingJobResponse_humanTaskConfig' - Configuration information required for human workers to complete a
-- labeling task.
newDescribeLabelingJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'labelingJobStatus'
  LabelingJobStatus ->
  -- | 'labelCounters'
  LabelCounters ->
  -- | 'creationTime'
  Prelude.UTCTime ->
  -- | 'lastModifiedTime'
  Prelude.UTCTime ->
  -- | 'jobReferenceCode'
  Prelude.Text ->
  -- | 'labelingJobName'
  Prelude.Text ->
  -- | 'labelingJobArn'
  Prelude.Text ->
  -- | 'inputConfig'
  LabelingJobInputConfig ->
  -- | 'outputConfig'
  LabelingJobOutputConfig ->
  -- | 'roleArn'
  Prelude.Text ->
  -- | 'humanTaskConfig'
  HumanTaskConfig ->
  DescribeLabelingJobResponse
newDescribeLabelingJobResponse :: Int
-> LabelingJobStatus
-> LabelCounters
-> UTCTime
-> UTCTime
-> Text
-> Text
-> Text
-> LabelingJobInputConfig
-> LabelingJobOutputConfig
-> Text
-> HumanTaskConfig
-> DescribeLabelingJobResponse
newDescribeLabelingJobResponse
  Int
pHttpStatus_
  LabelingJobStatus
pLabelingJobStatus_
  LabelCounters
pLabelCounters_
  UTCTime
pCreationTime_
  UTCTime
pLastModifiedTime_
  Text
pJobReferenceCode_
  Text
pLabelingJobName_
  Text
pLabelingJobArn_
  LabelingJobInputConfig
pInputConfig_
  LabelingJobOutputConfig
pOutputConfig_
  Text
pRoleArn_
  HumanTaskConfig
pHumanTaskConfig_ =
    DescribeLabelingJobResponse'
      { $sel:failureReason:DescribeLabelingJobResponse' :: Maybe Text
failureReason =
          forall a. Maybe a
Prelude.Nothing,
        $sel:labelAttributeName:DescribeLabelingJobResponse' :: Maybe Text
labelAttributeName = forall a. Maybe a
Prelude.Nothing,
        $sel:labelCategoryConfigS3Uri:DescribeLabelingJobResponse' :: Maybe Text
labelCategoryConfigS3Uri = forall a. Maybe a
Prelude.Nothing,
        $sel:labelingJobAlgorithmsConfig:DescribeLabelingJobResponse' :: Maybe LabelingJobAlgorithmsConfig
labelingJobAlgorithmsConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:labelingJobOutput:DescribeLabelingJobResponse' :: Maybe LabelingJobOutput
labelingJobOutput = forall a. Maybe a
Prelude.Nothing,
        $sel:stoppingConditions:DescribeLabelingJobResponse' :: Maybe LabelingJobStoppingConditions
stoppingConditions = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:DescribeLabelingJobResponse' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DescribeLabelingJobResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:labelingJobStatus:DescribeLabelingJobResponse' :: LabelingJobStatus
labelingJobStatus = LabelingJobStatus
pLabelingJobStatus_,
        $sel:labelCounters:DescribeLabelingJobResponse' :: LabelCounters
labelCounters = LabelCounters
pLabelCounters_,
        $sel:creationTime:DescribeLabelingJobResponse' :: POSIX
creationTime =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreationTime_,
        $sel:lastModifiedTime:DescribeLabelingJobResponse' :: POSIX
lastModifiedTime =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pLastModifiedTime_,
        $sel:jobReferenceCode:DescribeLabelingJobResponse' :: Text
jobReferenceCode = Text
pJobReferenceCode_,
        $sel:labelingJobName:DescribeLabelingJobResponse' :: Text
labelingJobName = Text
pLabelingJobName_,
        $sel:labelingJobArn:DescribeLabelingJobResponse' :: Text
labelingJobArn = Text
pLabelingJobArn_,
        $sel:inputConfig:DescribeLabelingJobResponse' :: LabelingJobInputConfig
inputConfig = LabelingJobInputConfig
pInputConfig_,
        $sel:outputConfig:DescribeLabelingJobResponse' :: LabelingJobOutputConfig
outputConfig = LabelingJobOutputConfig
pOutputConfig_,
        $sel:roleArn:DescribeLabelingJobResponse' :: Text
roleArn = Text
pRoleArn_,
        $sel:humanTaskConfig:DescribeLabelingJobResponse' :: HumanTaskConfig
humanTaskConfig = HumanTaskConfig
pHumanTaskConfig_
      }

-- | If the job failed, the reason that it failed.
describeLabelingJobResponse_failureReason :: Lens.Lens' DescribeLabelingJobResponse (Prelude.Maybe Prelude.Text)
describeLabelingJobResponse_failureReason :: Lens' DescribeLabelingJobResponse (Maybe Text)
describeLabelingJobResponse_failureReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLabelingJobResponse' {Maybe Text
failureReason :: Maybe Text
$sel:failureReason:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> Maybe Text
failureReason} -> Maybe Text
failureReason) (\s :: DescribeLabelingJobResponse
s@DescribeLabelingJobResponse' {} Maybe Text
a -> DescribeLabelingJobResponse
s {$sel:failureReason:DescribeLabelingJobResponse' :: Maybe Text
failureReason = Maybe Text
a} :: DescribeLabelingJobResponse)

-- | The attribute used as the label in the output manifest file.
describeLabelingJobResponse_labelAttributeName :: Lens.Lens' DescribeLabelingJobResponse (Prelude.Maybe Prelude.Text)
describeLabelingJobResponse_labelAttributeName :: Lens' DescribeLabelingJobResponse (Maybe Text)
describeLabelingJobResponse_labelAttributeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLabelingJobResponse' {Maybe Text
labelAttributeName :: Maybe Text
$sel:labelAttributeName:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> Maybe Text
labelAttributeName} -> Maybe Text
labelAttributeName) (\s :: DescribeLabelingJobResponse
s@DescribeLabelingJobResponse' {} Maybe Text
a -> DescribeLabelingJobResponse
s {$sel:labelAttributeName:DescribeLabelingJobResponse' :: Maybe Text
labelAttributeName = Maybe Text
a} :: DescribeLabelingJobResponse)

-- | The S3 location of the JSON file that defines the categories used to
-- label data objects. Please note the following label-category limits:
--
-- -   Semantic segmentation labeling jobs using automated labeling: 20
--     labels
--
-- -   Box bounding labeling jobs (all): 10 labels
--
-- The file is a JSON structure in the following format:
--
-- @{@
--
-- @ \"document-version\": \"2018-11-28\"@
--
-- @ \"labels\": [@
--
-- @ {@
--
-- @ \"label\": \"@/@label 1@/@\"@
--
-- @ },@
--
-- @ {@
--
-- @ \"label\": \"@/@label 2@/@\"@
--
-- @ },@
--
-- @ ...@
--
-- @ {@
--
-- @ \"label\": \"@/@label n@/@\"@
--
-- @ }@
--
-- @ ]@
--
-- @}@
describeLabelingJobResponse_labelCategoryConfigS3Uri :: Lens.Lens' DescribeLabelingJobResponse (Prelude.Maybe Prelude.Text)
describeLabelingJobResponse_labelCategoryConfigS3Uri :: Lens' DescribeLabelingJobResponse (Maybe Text)
describeLabelingJobResponse_labelCategoryConfigS3Uri = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLabelingJobResponse' {Maybe Text
labelCategoryConfigS3Uri :: Maybe Text
$sel:labelCategoryConfigS3Uri:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> Maybe Text
labelCategoryConfigS3Uri} -> Maybe Text
labelCategoryConfigS3Uri) (\s :: DescribeLabelingJobResponse
s@DescribeLabelingJobResponse' {} Maybe Text
a -> DescribeLabelingJobResponse
s {$sel:labelCategoryConfigS3Uri:DescribeLabelingJobResponse' :: Maybe Text
labelCategoryConfigS3Uri = Maybe Text
a} :: DescribeLabelingJobResponse)

-- | Configuration information for automated data labeling.
describeLabelingJobResponse_labelingJobAlgorithmsConfig :: Lens.Lens' DescribeLabelingJobResponse (Prelude.Maybe LabelingJobAlgorithmsConfig)
describeLabelingJobResponse_labelingJobAlgorithmsConfig :: Lens'
  DescribeLabelingJobResponse (Maybe LabelingJobAlgorithmsConfig)
describeLabelingJobResponse_labelingJobAlgorithmsConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLabelingJobResponse' {Maybe LabelingJobAlgorithmsConfig
labelingJobAlgorithmsConfig :: Maybe LabelingJobAlgorithmsConfig
$sel:labelingJobAlgorithmsConfig:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> Maybe LabelingJobAlgorithmsConfig
labelingJobAlgorithmsConfig} -> Maybe LabelingJobAlgorithmsConfig
labelingJobAlgorithmsConfig) (\s :: DescribeLabelingJobResponse
s@DescribeLabelingJobResponse' {} Maybe LabelingJobAlgorithmsConfig
a -> DescribeLabelingJobResponse
s {$sel:labelingJobAlgorithmsConfig:DescribeLabelingJobResponse' :: Maybe LabelingJobAlgorithmsConfig
labelingJobAlgorithmsConfig = Maybe LabelingJobAlgorithmsConfig
a} :: DescribeLabelingJobResponse)

-- | The location of the output produced by the labeling job.
describeLabelingJobResponse_labelingJobOutput :: Lens.Lens' DescribeLabelingJobResponse (Prelude.Maybe LabelingJobOutput)
describeLabelingJobResponse_labelingJobOutput :: Lens' DescribeLabelingJobResponse (Maybe LabelingJobOutput)
describeLabelingJobResponse_labelingJobOutput = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLabelingJobResponse' {Maybe LabelingJobOutput
labelingJobOutput :: Maybe LabelingJobOutput
$sel:labelingJobOutput:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> Maybe LabelingJobOutput
labelingJobOutput} -> Maybe LabelingJobOutput
labelingJobOutput) (\s :: DescribeLabelingJobResponse
s@DescribeLabelingJobResponse' {} Maybe LabelingJobOutput
a -> DescribeLabelingJobResponse
s {$sel:labelingJobOutput:DescribeLabelingJobResponse' :: Maybe LabelingJobOutput
labelingJobOutput = Maybe LabelingJobOutput
a} :: DescribeLabelingJobResponse)

-- | A set of conditions for stopping a labeling job. If any of the
-- conditions are met, the job is automatically stopped.
describeLabelingJobResponse_stoppingConditions :: Lens.Lens' DescribeLabelingJobResponse (Prelude.Maybe LabelingJobStoppingConditions)
describeLabelingJobResponse_stoppingConditions :: Lens'
  DescribeLabelingJobResponse (Maybe LabelingJobStoppingConditions)
describeLabelingJobResponse_stoppingConditions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLabelingJobResponse' {Maybe LabelingJobStoppingConditions
stoppingConditions :: Maybe LabelingJobStoppingConditions
$sel:stoppingConditions:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> Maybe LabelingJobStoppingConditions
stoppingConditions} -> Maybe LabelingJobStoppingConditions
stoppingConditions) (\s :: DescribeLabelingJobResponse
s@DescribeLabelingJobResponse' {} Maybe LabelingJobStoppingConditions
a -> DescribeLabelingJobResponse
s {$sel:stoppingConditions:DescribeLabelingJobResponse' :: Maybe LabelingJobStoppingConditions
stoppingConditions = Maybe LabelingJobStoppingConditions
a} :: DescribeLabelingJobResponse)

-- | An array of key-value pairs. You can use tags to categorize your Amazon
-- Web Services resources in different ways, for example, by purpose,
-- owner, or environment. For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services Resources>.
describeLabelingJobResponse_tags :: Lens.Lens' DescribeLabelingJobResponse (Prelude.Maybe [Tag])
describeLabelingJobResponse_tags :: Lens' DescribeLabelingJobResponse (Maybe [Tag])
describeLabelingJobResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLabelingJobResponse' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: DescribeLabelingJobResponse
s@DescribeLabelingJobResponse' {} Maybe [Tag]
a -> DescribeLabelingJobResponse
s {$sel:tags:DescribeLabelingJobResponse' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: DescribeLabelingJobResponse) 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.
describeLabelingJobResponse_httpStatus :: Lens.Lens' DescribeLabelingJobResponse Prelude.Int
describeLabelingJobResponse_httpStatus :: Lens' DescribeLabelingJobResponse Int
describeLabelingJobResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLabelingJobResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeLabelingJobResponse
s@DescribeLabelingJobResponse' {} Int
a -> DescribeLabelingJobResponse
s {$sel:httpStatus:DescribeLabelingJobResponse' :: Int
httpStatus = Int
a} :: DescribeLabelingJobResponse)

-- | The processing status of the labeling job.
describeLabelingJobResponse_labelingJobStatus :: Lens.Lens' DescribeLabelingJobResponse LabelingJobStatus
describeLabelingJobResponse_labelingJobStatus :: Lens' DescribeLabelingJobResponse LabelingJobStatus
describeLabelingJobResponse_labelingJobStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLabelingJobResponse' {LabelingJobStatus
labelingJobStatus :: LabelingJobStatus
$sel:labelingJobStatus:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> LabelingJobStatus
labelingJobStatus} -> LabelingJobStatus
labelingJobStatus) (\s :: DescribeLabelingJobResponse
s@DescribeLabelingJobResponse' {} LabelingJobStatus
a -> DescribeLabelingJobResponse
s {$sel:labelingJobStatus:DescribeLabelingJobResponse' :: LabelingJobStatus
labelingJobStatus = LabelingJobStatus
a} :: DescribeLabelingJobResponse)

-- | Provides a breakdown of the number of data objects labeled by humans,
-- the number of objects labeled by machine, the number of objects than
-- couldn\'t be labeled, and the total number of objects labeled.
describeLabelingJobResponse_labelCounters :: Lens.Lens' DescribeLabelingJobResponse LabelCounters
describeLabelingJobResponse_labelCounters :: Lens' DescribeLabelingJobResponse LabelCounters
describeLabelingJobResponse_labelCounters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLabelingJobResponse' {LabelCounters
labelCounters :: LabelCounters
$sel:labelCounters:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> LabelCounters
labelCounters} -> LabelCounters
labelCounters) (\s :: DescribeLabelingJobResponse
s@DescribeLabelingJobResponse' {} LabelCounters
a -> DescribeLabelingJobResponse
s {$sel:labelCounters:DescribeLabelingJobResponse' :: LabelCounters
labelCounters = LabelCounters
a} :: DescribeLabelingJobResponse)

-- | The date and time that the labeling job was created.
describeLabelingJobResponse_creationTime :: Lens.Lens' DescribeLabelingJobResponse Prelude.UTCTime
describeLabelingJobResponse_creationTime :: Lens' DescribeLabelingJobResponse UTCTime
describeLabelingJobResponse_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLabelingJobResponse' {POSIX
creationTime :: POSIX
$sel:creationTime:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> POSIX
creationTime} -> POSIX
creationTime) (\s :: DescribeLabelingJobResponse
s@DescribeLabelingJobResponse' {} POSIX
a -> DescribeLabelingJobResponse
s {$sel:creationTime:DescribeLabelingJobResponse' :: POSIX
creationTime = POSIX
a} :: DescribeLabelingJobResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The date and time that the labeling job was last updated.
describeLabelingJobResponse_lastModifiedTime :: Lens.Lens' DescribeLabelingJobResponse Prelude.UTCTime
describeLabelingJobResponse_lastModifiedTime :: Lens' DescribeLabelingJobResponse UTCTime
describeLabelingJobResponse_lastModifiedTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLabelingJobResponse' {POSIX
lastModifiedTime :: POSIX
$sel:lastModifiedTime:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> POSIX
lastModifiedTime} -> POSIX
lastModifiedTime) (\s :: DescribeLabelingJobResponse
s@DescribeLabelingJobResponse' {} POSIX
a -> DescribeLabelingJobResponse
s {$sel:lastModifiedTime:DescribeLabelingJobResponse' :: POSIX
lastModifiedTime = POSIX
a} :: DescribeLabelingJobResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | A unique identifier for work done as part of a labeling job.
describeLabelingJobResponse_jobReferenceCode :: Lens.Lens' DescribeLabelingJobResponse Prelude.Text
describeLabelingJobResponse_jobReferenceCode :: Lens' DescribeLabelingJobResponse Text
describeLabelingJobResponse_jobReferenceCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLabelingJobResponse' {Text
jobReferenceCode :: Text
$sel:jobReferenceCode:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> Text
jobReferenceCode} -> Text
jobReferenceCode) (\s :: DescribeLabelingJobResponse
s@DescribeLabelingJobResponse' {} Text
a -> DescribeLabelingJobResponse
s {$sel:jobReferenceCode:DescribeLabelingJobResponse' :: Text
jobReferenceCode = Text
a} :: DescribeLabelingJobResponse)

-- | The name assigned to the labeling job when it was created.
describeLabelingJobResponse_labelingJobName :: Lens.Lens' DescribeLabelingJobResponse Prelude.Text
describeLabelingJobResponse_labelingJobName :: Lens' DescribeLabelingJobResponse Text
describeLabelingJobResponse_labelingJobName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLabelingJobResponse' {Text
labelingJobName :: Text
$sel:labelingJobName:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> Text
labelingJobName} -> Text
labelingJobName) (\s :: DescribeLabelingJobResponse
s@DescribeLabelingJobResponse' {} Text
a -> DescribeLabelingJobResponse
s {$sel:labelingJobName:DescribeLabelingJobResponse' :: Text
labelingJobName = Text
a} :: DescribeLabelingJobResponse)

-- | The Amazon Resource Name (ARN) of the labeling job.
describeLabelingJobResponse_labelingJobArn :: Lens.Lens' DescribeLabelingJobResponse Prelude.Text
describeLabelingJobResponse_labelingJobArn :: Lens' DescribeLabelingJobResponse Text
describeLabelingJobResponse_labelingJobArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLabelingJobResponse' {Text
labelingJobArn :: Text
$sel:labelingJobArn:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> Text
labelingJobArn} -> Text
labelingJobArn) (\s :: DescribeLabelingJobResponse
s@DescribeLabelingJobResponse' {} Text
a -> DescribeLabelingJobResponse
s {$sel:labelingJobArn:DescribeLabelingJobResponse' :: Text
labelingJobArn = Text
a} :: DescribeLabelingJobResponse)

-- | Input configuration information for the labeling job, such as the Amazon
-- S3 location of the data objects and the location of the manifest file
-- that describes the data objects.
describeLabelingJobResponse_inputConfig :: Lens.Lens' DescribeLabelingJobResponse LabelingJobInputConfig
describeLabelingJobResponse_inputConfig :: Lens' DescribeLabelingJobResponse LabelingJobInputConfig
describeLabelingJobResponse_inputConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLabelingJobResponse' {LabelingJobInputConfig
inputConfig :: LabelingJobInputConfig
$sel:inputConfig:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> LabelingJobInputConfig
inputConfig} -> LabelingJobInputConfig
inputConfig) (\s :: DescribeLabelingJobResponse
s@DescribeLabelingJobResponse' {} LabelingJobInputConfig
a -> DescribeLabelingJobResponse
s {$sel:inputConfig:DescribeLabelingJobResponse' :: LabelingJobInputConfig
inputConfig = LabelingJobInputConfig
a} :: DescribeLabelingJobResponse)

-- | The location of the job\'s output data and the Amazon Web Services Key
-- Management Service key ID for the key used to encrypt the output data,
-- if any.
describeLabelingJobResponse_outputConfig :: Lens.Lens' DescribeLabelingJobResponse LabelingJobOutputConfig
describeLabelingJobResponse_outputConfig :: Lens' DescribeLabelingJobResponse LabelingJobOutputConfig
describeLabelingJobResponse_outputConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLabelingJobResponse' {LabelingJobOutputConfig
outputConfig :: LabelingJobOutputConfig
$sel:outputConfig:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> LabelingJobOutputConfig
outputConfig} -> LabelingJobOutputConfig
outputConfig) (\s :: DescribeLabelingJobResponse
s@DescribeLabelingJobResponse' {} LabelingJobOutputConfig
a -> DescribeLabelingJobResponse
s {$sel:outputConfig:DescribeLabelingJobResponse' :: LabelingJobOutputConfig
outputConfig = LabelingJobOutputConfig
a} :: DescribeLabelingJobResponse)

-- | The Amazon Resource Name (ARN) that SageMaker assumes to perform tasks
-- on your behalf during data labeling.
describeLabelingJobResponse_roleArn :: Lens.Lens' DescribeLabelingJobResponse Prelude.Text
describeLabelingJobResponse_roleArn :: Lens' DescribeLabelingJobResponse Text
describeLabelingJobResponse_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLabelingJobResponse' {Text
roleArn :: Text
$sel:roleArn:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> Text
roleArn} -> Text
roleArn) (\s :: DescribeLabelingJobResponse
s@DescribeLabelingJobResponse' {} Text
a -> DescribeLabelingJobResponse
s {$sel:roleArn:DescribeLabelingJobResponse' :: Text
roleArn = Text
a} :: DescribeLabelingJobResponse)

-- | Configuration information required for human workers to complete a
-- labeling task.
describeLabelingJobResponse_humanTaskConfig :: Lens.Lens' DescribeLabelingJobResponse HumanTaskConfig
describeLabelingJobResponse_humanTaskConfig :: Lens' DescribeLabelingJobResponse HumanTaskConfig
describeLabelingJobResponse_humanTaskConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeLabelingJobResponse' {HumanTaskConfig
humanTaskConfig :: HumanTaskConfig
$sel:humanTaskConfig:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> HumanTaskConfig
humanTaskConfig} -> HumanTaskConfig
humanTaskConfig) (\s :: DescribeLabelingJobResponse
s@DescribeLabelingJobResponse' {} HumanTaskConfig
a -> DescribeLabelingJobResponse
s {$sel:humanTaskConfig:DescribeLabelingJobResponse' :: HumanTaskConfig
humanTaskConfig = HumanTaskConfig
a} :: DescribeLabelingJobResponse)

instance Prelude.NFData DescribeLabelingJobResponse where
  rnf :: DescribeLabelingJobResponse -> ()
rnf DescribeLabelingJobResponse' {Int
Maybe [Tag]
Maybe Text
Maybe LabelingJobOutput
Maybe LabelingJobStoppingConditions
Maybe LabelingJobAlgorithmsConfig
Text
POSIX
LabelCounters
LabelingJobOutputConfig
LabelingJobInputConfig
LabelingJobStatus
HumanTaskConfig
humanTaskConfig :: HumanTaskConfig
roleArn :: Text
outputConfig :: LabelingJobOutputConfig
inputConfig :: LabelingJobInputConfig
labelingJobArn :: Text
labelingJobName :: Text
jobReferenceCode :: Text
lastModifiedTime :: POSIX
creationTime :: POSIX
labelCounters :: LabelCounters
labelingJobStatus :: LabelingJobStatus
httpStatus :: Int
tags :: Maybe [Tag]
stoppingConditions :: Maybe LabelingJobStoppingConditions
labelingJobOutput :: Maybe LabelingJobOutput
labelingJobAlgorithmsConfig :: Maybe LabelingJobAlgorithmsConfig
labelCategoryConfigS3Uri :: Maybe Text
labelAttributeName :: Maybe Text
failureReason :: Maybe Text
$sel:humanTaskConfig:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> HumanTaskConfig
$sel:roleArn:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> Text
$sel:outputConfig:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> LabelingJobOutputConfig
$sel:inputConfig:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> LabelingJobInputConfig
$sel:labelingJobArn:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> Text
$sel:labelingJobName:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> Text
$sel:jobReferenceCode:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> Text
$sel:lastModifiedTime:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> POSIX
$sel:creationTime:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> POSIX
$sel:labelCounters:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> LabelCounters
$sel:labelingJobStatus:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> LabelingJobStatus
$sel:httpStatus:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> Int
$sel:tags:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> Maybe [Tag]
$sel:stoppingConditions:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> Maybe LabelingJobStoppingConditions
$sel:labelingJobOutput:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> Maybe LabelingJobOutput
$sel:labelingJobAlgorithmsConfig:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> Maybe LabelingJobAlgorithmsConfig
$sel:labelCategoryConfigS3Uri:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> Maybe Text
$sel:labelAttributeName:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> Maybe Text
$sel:failureReason:DescribeLabelingJobResponse' :: DescribeLabelingJobResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
failureReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
labelAttributeName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
labelCategoryConfigS3Uri
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LabelingJobAlgorithmsConfig
labelingJobAlgorithmsConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LabelingJobOutput
labelingJobOutput
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LabelingJobStoppingConditions
stoppingConditions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf LabelingJobStatus
labelingJobStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf LabelCounters
labelCounters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
lastModifiedTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
jobReferenceCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
labelingJobName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
labelingJobArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf LabelingJobInputConfig
inputConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf LabelingJobOutputConfig
outputConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf HumanTaskConfig
humanTaskConfig