{-# 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.CreateLabelingJob
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a job that uses workers to label the data objects in your input
-- dataset. You can use the labeled data to train machine learning models.
--
-- You can select your workforce from one of three providers:
--
-- -   A private workforce that you create. It can include employees,
--     contractors, and outside experts. Use a private workforce when want
--     the data to stay within your organization or when a specific set of
--     skills is required.
--
-- -   One or more vendors that you select from the Amazon Web Services
--     Marketplace. Vendors provide expertise in specific areas.
--
-- -   The Amazon Mechanical Turk workforce. This is the largest workforce,
--     but it should only be used for public data or data that has been
--     stripped of any personally identifiable information.
--
-- You can also use /automated data labeling/ to reduce the number of data
-- objects that need to be labeled by a human. Automated data labeling uses
-- /active learning/ to determine if a data object can be labeled by
-- machine or if it needs to be sent to a human worker. For more
-- information, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/sms-automated-labeling.html Using Automated Data Labeling>.
--
-- The data objects to be labeled are contained in an Amazon S3 bucket. You
-- create a /manifest file/ that describes the location of each object. For
-- more information, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/sms-data.html Using Input and Output Data>.
--
-- The output can be used as the manifest file for another labeling job or
-- as training data for your machine learning models.
--
-- You can use this operation to create a static labeling job or a
-- streaming labeling job. A static labeling job stops if all data objects
-- in the input manifest file identified in @ManifestS3Uri@ have been
-- labeled. A streaming labeling job runs perpetually until it is manually
-- stopped, or remains idle for 10 days. You can send new data objects to
-- an active (@InProgress@) streaming labeling job in real time. To learn
-- how to create a static labeling job, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/sms-create-labeling-job-api.html Create a Labeling Job (API)>
-- in the Amazon SageMaker Developer Guide. To learn how to create a
-- streaming labeling job, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/sms-streaming-create-job.html Create a Streaming Labeling Job>.
module Amazonka.SageMaker.CreateLabelingJob
  ( -- * Creating a Request
    CreateLabelingJob (..),
    newCreateLabelingJob,

    -- * Request Lenses
    createLabelingJob_labelCategoryConfigS3Uri,
    createLabelingJob_labelingJobAlgorithmsConfig,
    createLabelingJob_stoppingConditions,
    createLabelingJob_tags,
    createLabelingJob_labelingJobName,
    createLabelingJob_labelAttributeName,
    createLabelingJob_inputConfig,
    createLabelingJob_outputConfig,
    createLabelingJob_roleArn,
    createLabelingJob_humanTaskConfig,

    -- * Destructuring the Response
    CreateLabelingJobResponse (..),
    newCreateLabelingJobResponse,

    -- * Response Lenses
    createLabelingJobResponse_httpStatus,
    createLabelingJobResponse_labelingJobArn,
  )
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:/ 'newCreateLabelingJob' smart constructor.
data CreateLabelingJob = CreateLabelingJob'
  { -- | The S3 URI of the file, referred to as a /label category configuration
    -- file/, that defines the categories used to label the data objects.
    --
    -- For 3D point cloud and video frame task types, you can add label
    -- category attributes and frame attributes to your label category
    -- configuration file. To learn how, see
    -- <https://docs.aws.amazon.com/sagemaker/latest/dg/sms-point-cloud-label-category-config.html Create a Labeling Category Configuration File for 3D Point Cloud Labeling Jobs>.
    --
    -- For named entity recognition jobs, in addition to @\"labels\"@, you must
    -- provide worker instructions in the label category configuration file
    -- using the @\"instructions\"@ parameter:
    -- @\"instructions\": {\"shortInstruction\":\"\<h1>Add header\<\/h1>\<p>Add Instructions\<\/p>\", \"fullInstruction\":\"\<p>Add additional instructions.\<\/p>\"}@.
    -- For details and an example, see
    -- <https://docs.aws.amazon.com/sagemaker/latest/dg/sms-named-entity-recg.html#sms-creating-ner-api Create a Named Entity Recognition Labeling Job (API)>
    -- .
    --
    -- For all other
    -- <https://docs.aws.amazon.com/sagemaker/latest/dg/sms-task-types.html built-in task types>
    -- and
    -- <https://docs.aws.amazon.com/sagemaker/latest/dg/sms-custom-templates.html custom tasks>,
    -- your label category configuration file must be a JSON file in the
    -- following format. Identify the labels you want to use by replacing
    -- @label_1@, @label_2@,@...@,@label_n@ with your label categories.
    --
    -- @{ @
    --
    -- @\"document-version\": \"2018-11-28\",@
    --
    -- @\"labels\": [{\"label\": \"label_1\"},{\"label\": \"label_2\"},...{\"label\": \"label_n\"}]@
    --
    -- @}@
    --
    -- Note the following about the label category configuration file:
    --
    -- -   For image classification and text classification (single and
    --     multi-label) you must specify at least two label categories. For all
    --     other task types, the minimum number of label categories required is
    --     one.
    --
    -- -   Each label category must be unique, you cannot specify duplicate
    --     label categories.
    --
    -- -   If you create a 3D point cloud or video frame adjustment or
    --     verification labeling job, you must include
    --     @auditLabelAttributeName@ in the label category configuration. Use
    --     this parameter to enter the
    --     <https://docs.aws.amazon.com/sagemaker/latest/APIReference/API_CreateLabelingJob.html#sagemaker-CreateLabelingJob-request-LabelAttributeName LabelAttributeName>
    --     of the labeling job you want to adjust or verify annotations of.
    CreateLabelingJob -> Maybe Text
labelCategoryConfigS3Uri :: Prelude.Maybe Prelude.Text,
    -- | Configures the information required to perform automated data labeling.
    CreateLabelingJob -> Maybe LabelingJobAlgorithmsConfig
labelingJobAlgorithmsConfig :: Prelude.Maybe LabelingJobAlgorithmsConfig,
    -- | A set of conditions for stopping the labeling job. If any of the
    -- conditions are met, the job is automatically stopped. You can use these
    -- conditions to control the cost of data labeling.
    CreateLabelingJob -> Maybe LabelingJobStoppingConditions
stoppingConditions :: Prelude.Maybe LabelingJobStoppingConditions,
    -- | An array of key\/value pairs. For more information, see
    -- <https://docs.aws.amazon.com/awsaccountbilling/latest/aboutv2/cost-alloc-tags.html#allocation-what Using Cost Allocation Tags>
    -- in the /Amazon Web Services Billing and Cost Management User Guide/.
    CreateLabelingJob -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name of the labeling job. This name is used to identify the job in a
    -- list of labeling jobs. Labeling job names must be unique within an
    -- Amazon Web Services account and region. @LabelingJobName@ is not case
    -- sensitive. For example, Example-job and example-job are considered the
    -- same labeling job name by Ground Truth.
    CreateLabelingJob -> Text
labelingJobName :: Prelude.Text,
    -- | The attribute name to use for the label in the output manifest file.
    -- This is the key for the key\/value pair formed with the label that a
    -- worker assigns to the object. The @LabelAttributeName@ must meet the
    -- following requirements.
    --
    -- -   The name can\'t end with \"-metadata\".
    --
    -- -   If you are using one of the following
    --     <https://docs.aws.amazon.com/sagemaker/latest/dg/sms-task-types.html built-in task types>,
    --     the attribute name /must/ end with \"-ref\". If the task type you
    --     are using is not listed below, the attribute name /must not/ end
    --     with \"-ref\".
    --
    --     -   Image semantic segmentation (@SemanticSegmentation)@, and
    --         adjustment (@AdjustmentSemanticSegmentation@) and verification
    --         (@VerificationSemanticSegmentation@) labeling jobs for this task
    --         type.
    --
    --     -   Video frame object detection (@VideoObjectDetection@), and
    --         adjustment and verification (@AdjustmentVideoObjectDetection@)
    --         labeling jobs for this task type.
    --
    --     -   Video frame object tracking (@VideoObjectTracking@), and
    --         adjustment and verification (@AdjustmentVideoObjectTracking@)
    --         labeling jobs for this task type.
    --
    --     -   3D point cloud semantic segmentation
    --         (@3DPointCloudSemanticSegmentation@), and adjustment and
    --         verification (@Adjustment3DPointCloudSemanticSegmentation@)
    --         labeling jobs for this task type.
    --
    --     -   3D point cloud object tracking (@3DPointCloudObjectTracking@),
    --         and adjustment and verification
    --         (@Adjustment3DPointCloudObjectTracking@) labeling jobs for this
    --         task type.
    --
    -- If you are creating an adjustment or verification labeling job, you must
    -- use a /different/ @LabelAttributeName@ than the one used in the original
    -- labeling job. The original labeling job is the Ground Truth labeling job
    -- that produced the labels that you want verified or adjusted. To learn
    -- more about adjustment and verification labeling jobs, see
    -- <https://docs.aws.amazon.com/sagemaker/latest/dg/sms-verification-data.html Verify and Adjust Labels>.
    CreateLabelingJob -> Text
labelAttributeName :: Prelude.Text,
    -- | Input data 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.
    --
    -- You must specify at least one of the following: @S3DataSource@ or
    -- @SnsDataSource@.
    --
    -- -   Use @SnsDataSource@ to specify an SNS input topic for a streaming
    --     labeling job. If you do not specify and SNS input topic ARN, Ground
    --     Truth will create a one-time labeling job that stops after all data
    --     objects in the input manifest file have been labeled.
    --
    -- -   Use @S3DataSource@ to specify an input manifest file for both
    --     streaming and one-time labeling jobs. Adding an @S3DataSource@ is
    --     optional if you use @SnsDataSource@ to create a streaming labeling
    --     job.
    --
    -- If you use the Amazon Mechanical Turk workforce, your input data should
    -- not include confidential information, personal information or protected
    -- health information. Use @ContentClassifiers@ to specify that your data
    -- is free of personally identifiable information and adult content.
    CreateLabelingJob -> LabelingJobInputConfig
inputConfig :: LabelingJobInputConfig,
    -- | The location of the output data and the Amazon Web Services Key
    -- Management Service key ID for the key used to encrypt the output data,
    -- if any.
    CreateLabelingJob -> LabelingJobOutputConfig
outputConfig :: LabelingJobOutputConfig,
    -- | The Amazon Resource Number (ARN) that Amazon SageMaker assumes to
    -- perform tasks on your behalf during data labeling. You must grant this
    -- role the necessary permissions so that Amazon SageMaker can successfully
    -- complete data labeling.
    CreateLabelingJob -> Text
roleArn :: Prelude.Text,
    -- | Configures the labeling task and how it is presented to workers;
    -- including, but not limited to price, keywords, and batch size (task
    -- count).
    CreateLabelingJob -> HumanTaskConfig
humanTaskConfig :: HumanTaskConfig
  }
  deriving (CreateLabelingJob -> CreateLabelingJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLabelingJob -> CreateLabelingJob -> Bool
$c/= :: CreateLabelingJob -> CreateLabelingJob -> Bool
== :: CreateLabelingJob -> CreateLabelingJob -> Bool
$c== :: CreateLabelingJob -> CreateLabelingJob -> Bool
Prelude.Eq, ReadPrec [CreateLabelingJob]
ReadPrec CreateLabelingJob
Int -> ReadS CreateLabelingJob
ReadS [CreateLabelingJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLabelingJob]
$creadListPrec :: ReadPrec [CreateLabelingJob]
readPrec :: ReadPrec CreateLabelingJob
$creadPrec :: ReadPrec CreateLabelingJob
readList :: ReadS [CreateLabelingJob]
$creadList :: ReadS [CreateLabelingJob]
readsPrec :: Int -> ReadS CreateLabelingJob
$creadsPrec :: Int -> ReadS CreateLabelingJob
Prelude.Read, Int -> CreateLabelingJob -> ShowS
[CreateLabelingJob] -> ShowS
CreateLabelingJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLabelingJob] -> ShowS
$cshowList :: [CreateLabelingJob] -> ShowS
show :: CreateLabelingJob -> String
$cshow :: CreateLabelingJob -> String
showsPrec :: Int -> CreateLabelingJob -> ShowS
$cshowsPrec :: Int -> CreateLabelingJob -> ShowS
Prelude.Show, forall x. Rep CreateLabelingJob x -> CreateLabelingJob
forall x. CreateLabelingJob -> Rep CreateLabelingJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateLabelingJob x -> CreateLabelingJob
$cfrom :: forall x. CreateLabelingJob -> Rep CreateLabelingJob x
Prelude.Generic)

-- |
-- Create a value of 'CreateLabelingJob' 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:
--
-- 'labelCategoryConfigS3Uri', 'createLabelingJob_labelCategoryConfigS3Uri' - The S3 URI of the file, referred to as a /label category configuration
-- file/, that defines the categories used to label the data objects.
--
-- For 3D point cloud and video frame task types, you can add label
-- category attributes and frame attributes to your label category
-- configuration file. To learn how, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/sms-point-cloud-label-category-config.html Create a Labeling Category Configuration File for 3D Point Cloud Labeling Jobs>.
--
-- For named entity recognition jobs, in addition to @\"labels\"@, you must
-- provide worker instructions in the label category configuration file
-- using the @\"instructions\"@ parameter:
-- @\"instructions\": {\"shortInstruction\":\"\<h1>Add header\<\/h1>\<p>Add Instructions\<\/p>\", \"fullInstruction\":\"\<p>Add additional instructions.\<\/p>\"}@.
-- For details and an example, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/sms-named-entity-recg.html#sms-creating-ner-api Create a Named Entity Recognition Labeling Job (API)>
-- .
--
-- For all other
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/sms-task-types.html built-in task types>
-- and
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/sms-custom-templates.html custom tasks>,
-- your label category configuration file must be a JSON file in the
-- following format. Identify the labels you want to use by replacing
-- @label_1@, @label_2@,@...@,@label_n@ with your label categories.
--
-- @{ @
--
-- @\"document-version\": \"2018-11-28\",@
--
-- @\"labels\": [{\"label\": \"label_1\"},{\"label\": \"label_2\"},...{\"label\": \"label_n\"}]@
--
-- @}@
--
-- Note the following about the label category configuration file:
--
-- -   For image classification and text classification (single and
--     multi-label) you must specify at least two label categories. For all
--     other task types, the minimum number of label categories required is
--     one.
--
-- -   Each label category must be unique, you cannot specify duplicate
--     label categories.
--
-- -   If you create a 3D point cloud or video frame adjustment or
--     verification labeling job, you must include
--     @auditLabelAttributeName@ in the label category configuration. Use
--     this parameter to enter the
--     <https://docs.aws.amazon.com/sagemaker/latest/APIReference/API_CreateLabelingJob.html#sagemaker-CreateLabelingJob-request-LabelAttributeName LabelAttributeName>
--     of the labeling job you want to adjust or verify annotations of.
--
-- 'labelingJobAlgorithmsConfig', 'createLabelingJob_labelingJobAlgorithmsConfig' - Configures the information required to perform automated data labeling.
--
-- 'stoppingConditions', 'createLabelingJob_stoppingConditions' - A set of conditions for stopping the labeling job. If any of the
-- conditions are met, the job is automatically stopped. You can use these
-- conditions to control the cost of data labeling.
--
-- 'tags', 'createLabelingJob_tags' - An array of key\/value pairs. For more information, see
-- <https://docs.aws.amazon.com/awsaccountbilling/latest/aboutv2/cost-alloc-tags.html#allocation-what Using Cost Allocation Tags>
-- in the /Amazon Web Services Billing and Cost Management User Guide/.
--
-- 'labelingJobName', 'createLabelingJob_labelingJobName' - The name of the labeling job. This name is used to identify the job in a
-- list of labeling jobs. Labeling job names must be unique within an
-- Amazon Web Services account and region. @LabelingJobName@ is not case
-- sensitive. For example, Example-job and example-job are considered the
-- same labeling job name by Ground Truth.
--
-- 'labelAttributeName', 'createLabelingJob_labelAttributeName' - The attribute name to use for the label in the output manifest file.
-- This is the key for the key\/value pair formed with the label that a
-- worker assigns to the object. The @LabelAttributeName@ must meet the
-- following requirements.
--
-- -   The name can\'t end with \"-metadata\".
--
-- -   If you are using one of the following
--     <https://docs.aws.amazon.com/sagemaker/latest/dg/sms-task-types.html built-in task types>,
--     the attribute name /must/ end with \"-ref\". If the task type you
--     are using is not listed below, the attribute name /must not/ end
--     with \"-ref\".
--
--     -   Image semantic segmentation (@SemanticSegmentation)@, and
--         adjustment (@AdjustmentSemanticSegmentation@) and verification
--         (@VerificationSemanticSegmentation@) labeling jobs for this task
--         type.
--
--     -   Video frame object detection (@VideoObjectDetection@), and
--         adjustment and verification (@AdjustmentVideoObjectDetection@)
--         labeling jobs for this task type.
--
--     -   Video frame object tracking (@VideoObjectTracking@), and
--         adjustment and verification (@AdjustmentVideoObjectTracking@)
--         labeling jobs for this task type.
--
--     -   3D point cloud semantic segmentation
--         (@3DPointCloudSemanticSegmentation@), and adjustment and
--         verification (@Adjustment3DPointCloudSemanticSegmentation@)
--         labeling jobs for this task type.
--
--     -   3D point cloud object tracking (@3DPointCloudObjectTracking@),
--         and adjustment and verification
--         (@Adjustment3DPointCloudObjectTracking@) labeling jobs for this
--         task type.
--
-- If you are creating an adjustment or verification labeling job, you must
-- use a /different/ @LabelAttributeName@ than the one used in the original
-- labeling job. The original labeling job is the Ground Truth labeling job
-- that produced the labels that you want verified or adjusted. To learn
-- more about adjustment and verification labeling jobs, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/sms-verification-data.html Verify and Adjust Labels>.
--
-- 'inputConfig', 'createLabelingJob_inputConfig' - Input data 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.
--
-- You must specify at least one of the following: @S3DataSource@ or
-- @SnsDataSource@.
--
-- -   Use @SnsDataSource@ to specify an SNS input topic for a streaming
--     labeling job. If you do not specify and SNS input topic ARN, Ground
--     Truth will create a one-time labeling job that stops after all data
--     objects in the input manifest file have been labeled.
--
-- -   Use @S3DataSource@ to specify an input manifest file for both
--     streaming and one-time labeling jobs. Adding an @S3DataSource@ is
--     optional if you use @SnsDataSource@ to create a streaming labeling
--     job.
--
-- If you use the Amazon Mechanical Turk workforce, your input data should
-- not include confidential information, personal information or protected
-- health information. Use @ContentClassifiers@ to specify that your data
-- is free of personally identifiable information and adult content.
--
-- 'outputConfig', 'createLabelingJob_outputConfig' - The location of the output data and the Amazon Web Services Key
-- Management Service key ID for the key used to encrypt the output data,
-- if any.
--
-- 'roleArn', 'createLabelingJob_roleArn' - The Amazon Resource Number (ARN) that Amazon SageMaker assumes to
-- perform tasks on your behalf during data labeling. You must grant this
-- role the necessary permissions so that Amazon SageMaker can successfully
-- complete data labeling.
--
-- 'humanTaskConfig', 'createLabelingJob_humanTaskConfig' - Configures the labeling task and how it is presented to workers;
-- including, but not limited to price, keywords, and batch size (task
-- count).
newCreateLabelingJob ::
  -- | 'labelingJobName'
  Prelude.Text ->
  -- | 'labelAttributeName'
  Prelude.Text ->
  -- | 'inputConfig'
  LabelingJobInputConfig ->
  -- | 'outputConfig'
  LabelingJobOutputConfig ->
  -- | 'roleArn'
  Prelude.Text ->
  -- | 'humanTaskConfig'
  HumanTaskConfig ->
  CreateLabelingJob
newCreateLabelingJob :: Text
-> Text
-> LabelingJobInputConfig
-> LabelingJobOutputConfig
-> Text
-> HumanTaskConfig
-> CreateLabelingJob
newCreateLabelingJob
  Text
pLabelingJobName_
  Text
pLabelAttributeName_
  LabelingJobInputConfig
pInputConfig_
  LabelingJobOutputConfig
pOutputConfig_
  Text
pRoleArn_
  HumanTaskConfig
pHumanTaskConfig_ =
    CreateLabelingJob'
      { $sel:labelCategoryConfigS3Uri:CreateLabelingJob' :: Maybe Text
labelCategoryConfigS3Uri =
          forall a. Maybe a
Prelude.Nothing,
        $sel:labelingJobAlgorithmsConfig:CreateLabelingJob' :: Maybe LabelingJobAlgorithmsConfig
labelingJobAlgorithmsConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:stoppingConditions:CreateLabelingJob' :: Maybe LabelingJobStoppingConditions
stoppingConditions = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateLabelingJob' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:labelingJobName:CreateLabelingJob' :: Text
labelingJobName = Text
pLabelingJobName_,
        $sel:labelAttributeName:CreateLabelingJob' :: Text
labelAttributeName = Text
pLabelAttributeName_,
        $sel:inputConfig:CreateLabelingJob' :: LabelingJobInputConfig
inputConfig = LabelingJobInputConfig
pInputConfig_,
        $sel:outputConfig:CreateLabelingJob' :: LabelingJobOutputConfig
outputConfig = LabelingJobOutputConfig
pOutputConfig_,
        $sel:roleArn:CreateLabelingJob' :: Text
roleArn = Text
pRoleArn_,
        $sel:humanTaskConfig:CreateLabelingJob' :: HumanTaskConfig
humanTaskConfig = HumanTaskConfig
pHumanTaskConfig_
      }

-- | The S3 URI of the file, referred to as a /label category configuration
-- file/, that defines the categories used to label the data objects.
--
-- For 3D point cloud and video frame task types, you can add label
-- category attributes and frame attributes to your label category
-- configuration file. To learn how, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/sms-point-cloud-label-category-config.html Create a Labeling Category Configuration File for 3D Point Cloud Labeling Jobs>.
--
-- For named entity recognition jobs, in addition to @\"labels\"@, you must
-- provide worker instructions in the label category configuration file
-- using the @\"instructions\"@ parameter:
-- @\"instructions\": {\"shortInstruction\":\"\<h1>Add header\<\/h1>\<p>Add Instructions\<\/p>\", \"fullInstruction\":\"\<p>Add additional instructions.\<\/p>\"}@.
-- For details and an example, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/sms-named-entity-recg.html#sms-creating-ner-api Create a Named Entity Recognition Labeling Job (API)>
-- .
--
-- For all other
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/sms-task-types.html built-in task types>
-- and
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/sms-custom-templates.html custom tasks>,
-- your label category configuration file must be a JSON file in the
-- following format. Identify the labels you want to use by replacing
-- @label_1@, @label_2@,@...@,@label_n@ with your label categories.
--
-- @{ @
--
-- @\"document-version\": \"2018-11-28\",@
--
-- @\"labels\": [{\"label\": \"label_1\"},{\"label\": \"label_2\"},...{\"label\": \"label_n\"}]@
--
-- @}@
--
-- Note the following about the label category configuration file:
--
-- -   For image classification and text classification (single and
--     multi-label) you must specify at least two label categories. For all
--     other task types, the minimum number of label categories required is
--     one.
--
-- -   Each label category must be unique, you cannot specify duplicate
--     label categories.
--
-- -   If you create a 3D point cloud or video frame adjustment or
--     verification labeling job, you must include
--     @auditLabelAttributeName@ in the label category configuration. Use
--     this parameter to enter the
--     <https://docs.aws.amazon.com/sagemaker/latest/APIReference/API_CreateLabelingJob.html#sagemaker-CreateLabelingJob-request-LabelAttributeName LabelAttributeName>
--     of the labeling job you want to adjust or verify annotations of.
createLabelingJob_labelCategoryConfigS3Uri :: Lens.Lens' CreateLabelingJob (Prelude.Maybe Prelude.Text)
createLabelingJob_labelCategoryConfigS3Uri :: Lens' CreateLabelingJob (Maybe Text)
createLabelingJob_labelCategoryConfigS3Uri = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLabelingJob' {Maybe Text
labelCategoryConfigS3Uri :: Maybe Text
$sel:labelCategoryConfigS3Uri:CreateLabelingJob' :: CreateLabelingJob -> Maybe Text
labelCategoryConfigS3Uri} -> Maybe Text
labelCategoryConfigS3Uri) (\s :: CreateLabelingJob
s@CreateLabelingJob' {} Maybe Text
a -> CreateLabelingJob
s {$sel:labelCategoryConfigS3Uri:CreateLabelingJob' :: Maybe Text
labelCategoryConfigS3Uri = Maybe Text
a} :: CreateLabelingJob)

-- | Configures the information required to perform automated data labeling.
createLabelingJob_labelingJobAlgorithmsConfig :: Lens.Lens' CreateLabelingJob (Prelude.Maybe LabelingJobAlgorithmsConfig)
createLabelingJob_labelingJobAlgorithmsConfig :: Lens' CreateLabelingJob (Maybe LabelingJobAlgorithmsConfig)
createLabelingJob_labelingJobAlgorithmsConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLabelingJob' {Maybe LabelingJobAlgorithmsConfig
labelingJobAlgorithmsConfig :: Maybe LabelingJobAlgorithmsConfig
$sel:labelingJobAlgorithmsConfig:CreateLabelingJob' :: CreateLabelingJob -> Maybe LabelingJobAlgorithmsConfig
labelingJobAlgorithmsConfig} -> Maybe LabelingJobAlgorithmsConfig
labelingJobAlgorithmsConfig) (\s :: CreateLabelingJob
s@CreateLabelingJob' {} Maybe LabelingJobAlgorithmsConfig
a -> CreateLabelingJob
s {$sel:labelingJobAlgorithmsConfig:CreateLabelingJob' :: Maybe LabelingJobAlgorithmsConfig
labelingJobAlgorithmsConfig = Maybe LabelingJobAlgorithmsConfig
a} :: CreateLabelingJob)

-- | A set of conditions for stopping the labeling job. If any of the
-- conditions are met, the job is automatically stopped. You can use these
-- conditions to control the cost of data labeling.
createLabelingJob_stoppingConditions :: Lens.Lens' CreateLabelingJob (Prelude.Maybe LabelingJobStoppingConditions)
createLabelingJob_stoppingConditions :: Lens' CreateLabelingJob (Maybe LabelingJobStoppingConditions)
createLabelingJob_stoppingConditions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLabelingJob' {Maybe LabelingJobStoppingConditions
stoppingConditions :: Maybe LabelingJobStoppingConditions
$sel:stoppingConditions:CreateLabelingJob' :: CreateLabelingJob -> Maybe LabelingJobStoppingConditions
stoppingConditions} -> Maybe LabelingJobStoppingConditions
stoppingConditions) (\s :: CreateLabelingJob
s@CreateLabelingJob' {} Maybe LabelingJobStoppingConditions
a -> CreateLabelingJob
s {$sel:stoppingConditions:CreateLabelingJob' :: Maybe LabelingJobStoppingConditions
stoppingConditions = Maybe LabelingJobStoppingConditions
a} :: CreateLabelingJob)

-- | An array of key\/value pairs. For more information, see
-- <https://docs.aws.amazon.com/awsaccountbilling/latest/aboutv2/cost-alloc-tags.html#allocation-what Using Cost Allocation Tags>
-- in the /Amazon Web Services Billing and Cost Management User Guide/.
createLabelingJob_tags :: Lens.Lens' CreateLabelingJob (Prelude.Maybe [Tag])
createLabelingJob_tags :: Lens' CreateLabelingJob (Maybe [Tag])
createLabelingJob_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLabelingJob' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateLabelingJob' :: CreateLabelingJob -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateLabelingJob
s@CreateLabelingJob' {} Maybe [Tag]
a -> CreateLabelingJob
s {$sel:tags:CreateLabelingJob' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateLabelingJob) 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 name of the labeling job. This name is used to identify the job in a
-- list of labeling jobs. Labeling job names must be unique within an
-- Amazon Web Services account and region. @LabelingJobName@ is not case
-- sensitive. For example, Example-job and example-job are considered the
-- same labeling job name by Ground Truth.
createLabelingJob_labelingJobName :: Lens.Lens' CreateLabelingJob Prelude.Text
createLabelingJob_labelingJobName :: Lens' CreateLabelingJob Text
createLabelingJob_labelingJobName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLabelingJob' {Text
labelingJobName :: Text
$sel:labelingJobName:CreateLabelingJob' :: CreateLabelingJob -> Text
labelingJobName} -> Text
labelingJobName) (\s :: CreateLabelingJob
s@CreateLabelingJob' {} Text
a -> CreateLabelingJob
s {$sel:labelingJobName:CreateLabelingJob' :: Text
labelingJobName = Text
a} :: CreateLabelingJob)

-- | The attribute name to use for the label in the output manifest file.
-- This is the key for the key\/value pair formed with the label that a
-- worker assigns to the object. The @LabelAttributeName@ must meet the
-- following requirements.
--
-- -   The name can\'t end with \"-metadata\".
--
-- -   If you are using one of the following
--     <https://docs.aws.amazon.com/sagemaker/latest/dg/sms-task-types.html built-in task types>,
--     the attribute name /must/ end with \"-ref\". If the task type you
--     are using is not listed below, the attribute name /must not/ end
--     with \"-ref\".
--
--     -   Image semantic segmentation (@SemanticSegmentation)@, and
--         adjustment (@AdjustmentSemanticSegmentation@) and verification
--         (@VerificationSemanticSegmentation@) labeling jobs for this task
--         type.
--
--     -   Video frame object detection (@VideoObjectDetection@), and
--         adjustment and verification (@AdjustmentVideoObjectDetection@)
--         labeling jobs for this task type.
--
--     -   Video frame object tracking (@VideoObjectTracking@), and
--         adjustment and verification (@AdjustmentVideoObjectTracking@)
--         labeling jobs for this task type.
--
--     -   3D point cloud semantic segmentation
--         (@3DPointCloudSemanticSegmentation@), and adjustment and
--         verification (@Adjustment3DPointCloudSemanticSegmentation@)
--         labeling jobs for this task type.
--
--     -   3D point cloud object tracking (@3DPointCloudObjectTracking@),
--         and adjustment and verification
--         (@Adjustment3DPointCloudObjectTracking@) labeling jobs for this
--         task type.
--
-- If you are creating an adjustment or verification labeling job, you must
-- use a /different/ @LabelAttributeName@ than the one used in the original
-- labeling job. The original labeling job is the Ground Truth labeling job
-- that produced the labels that you want verified or adjusted. To learn
-- more about adjustment and verification labeling jobs, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/sms-verification-data.html Verify and Adjust Labels>.
createLabelingJob_labelAttributeName :: Lens.Lens' CreateLabelingJob Prelude.Text
createLabelingJob_labelAttributeName :: Lens' CreateLabelingJob Text
createLabelingJob_labelAttributeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLabelingJob' {Text
labelAttributeName :: Text
$sel:labelAttributeName:CreateLabelingJob' :: CreateLabelingJob -> Text
labelAttributeName} -> Text
labelAttributeName) (\s :: CreateLabelingJob
s@CreateLabelingJob' {} Text
a -> CreateLabelingJob
s {$sel:labelAttributeName:CreateLabelingJob' :: Text
labelAttributeName = Text
a} :: CreateLabelingJob)

-- | Input data 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.
--
-- You must specify at least one of the following: @S3DataSource@ or
-- @SnsDataSource@.
--
-- -   Use @SnsDataSource@ to specify an SNS input topic for a streaming
--     labeling job. If you do not specify and SNS input topic ARN, Ground
--     Truth will create a one-time labeling job that stops after all data
--     objects in the input manifest file have been labeled.
--
-- -   Use @S3DataSource@ to specify an input manifest file for both
--     streaming and one-time labeling jobs. Adding an @S3DataSource@ is
--     optional if you use @SnsDataSource@ to create a streaming labeling
--     job.
--
-- If you use the Amazon Mechanical Turk workforce, your input data should
-- not include confidential information, personal information or protected
-- health information. Use @ContentClassifiers@ to specify that your data
-- is free of personally identifiable information and adult content.
createLabelingJob_inputConfig :: Lens.Lens' CreateLabelingJob LabelingJobInputConfig
createLabelingJob_inputConfig :: Lens' CreateLabelingJob LabelingJobInputConfig
createLabelingJob_inputConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLabelingJob' {LabelingJobInputConfig
inputConfig :: LabelingJobInputConfig
$sel:inputConfig:CreateLabelingJob' :: CreateLabelingJob -> LabelingJobInputConfig
inputConfig} -> LabelingJobInputConfig
inputConfig) (\s :: CreateLabelingJob
s@CreateLabelingJob' {} LabelingJobInputConfig
a -> CreateLabelingJob
s {$sel:inputConfig:CreateLabelingJob' :: LabelingJobInputConfig
inputConfig = LabelingJobInputConfig
a} :: CreateLabelingJob)

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

-- | The Amazon Resource Number (ARN) that Amazon SageMaker assumes to
-- perform tasks on your behalf during data labeling. You must grant this
-- role the necessary permissions so that Amazon SageMaker can successfully
-- complete data labeling.
createLabelingJob_roleArn :: Lens.Lens' CreateLabelingJob Prelude.Text
createLabelingJob_roleArn :: Lens' CreateLabelingJob Text
createLabelingJob_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLabelingJob' {Text
roleArn :: Text
$sel:roleArn:CreateLabelingJob' :: CreateLabelingJob -> Text
roleArn} -> Text
roleArn) (\s :: CreateLabelingJob
s@CreateLabelingJob' {} Text
a -> CreateLabelingJob
s {$sel:roleArn:CreateLabelingJob' :: Text
roleArn = Text
a} :: CreateLabelingJob)

-- | Configures the labeling task and how it is presented to workers;
-- including, but not limited to price, keywords, and batch size (task
-- count).
createLabelingJob_humanTaskConfig :: Lens.Lens' CreateLabelingJob HumanTaskConfig
createLabelingJob_humanTaskConfig :: Lens' CreateLabelingJob HumanTaskConfig
createLabelingJob_humanTaskConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLabelingJob' {HumanTaskConfig
humanTaskConfig :: HumanTaskConfig
$sel:humanTaskConfig:CreateLabelingJob' :: CreateLabelingJob -> HumanTaskConfig
humanTaskConfig} -> HumanTaskConfig
humanTaskConfig) (\s :: CreateLabelingJob
s@CreateLabelingJob' {} HumanTaskConfig
a -> CreateLabelingJob
s {$sel:humanTaskConfig:CreateLabelingJob' :: HumanTaskConfig
humanTaskConfig = HumanTaskConfig
a} :: CreateLabelingJob)

instance Core.AWSRequest CreateLabelingJob where
  type
    AWSResponse CreateLabelingJob =
      CreateLabelingJobResponse
  request :: (Service -> Service)
-> CreateLabelingJob -> Request CreateLabelingJob
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 CreateLabelingJob
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateLabelingJob)))
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 ->
          Int -> Text -> CreateLabelingJobResponse
CreateLabelingJobResponse'
            forall (f :: * -> *) a b. Functor 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
"LabelingJobArn")
      )

instance Prelude.Hashable CreateLabelingJob where
  hashWithSalt :: Int -> CreateLabelingJob -> Int
hashWithSalt Int
_salt CreateLabelingJob' {Maybe [Tag]
Maybe Text
Maybe LabelingJobStoppingConditions
Maybe LabelingJobAlgorithmsConfig
Text
LabelingJobOutputConfig
LabelingJobInputConfig
HumanTaskConfig
humanTaskConfig :: HumanTaskConfig
roleArn :: Text
outputConfig :: LabelingJobOutputConfig
inputConfig :: LabelingJobInputConfig
labelAttributeName :: Text
labelingJobName :: Text
tags :: Maybe [Tag]
stoppingConditions :: Maybe LabelingJobStoppingConditions
labelingJobAlgorithmsConfig :: Maybe LabelingJobAlgorithmsConfig
labelCategoryConfigS3Uri :: Maybe Text
$sel:humanTaskConfig:CreateLabelingJob' :: CreateLabelingJob -> HumanTaskConfig
$sel:roleArn:CreateLabelingJob' :: CreateLabelingJob -> Text
$sel:outputConfig:CreateLabelingJob' :: CreateLabelingJob -> LabelingJobOutputConfig
$sel:inputConfig:CreateLabelingJob' :: CreateLabelingJob -> LabelingJobInputConfig
$sel:labelAttributeName:CreateLabelingJob' :: CreateLabelingJob -> Text
$sel:labelingJobName:CreateLabelingJob' :: CreateLabelingJob -> Text
$sel:tags:CreateLabelingJob' :: CreateLabelingJob -> Maybe [Tag]
$sel:stoppingConditions:CreateLabelingJob' :: CreateLabelingJob -> Maybe LabelingJobStoppingConditions
$sel:labelingJobAlgorithmsConfig:CreateLabelingJob' :: CreateLabelingJob -> Maybe LabelingJobAlgorithmsConfig
$sel:labelCategoryConfigS3Uri:CreateLabelingJob' :: CreateLabelingJob -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
labelCategoryConfigS3Uri
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LabelingJobAlgorithmsConfig
labelingJobAlgorithmsConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LabelingJobStoppingConditions
stoppingConditions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
labelingJobName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
labelAttributeName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` LabelingJobInputConfig
inputConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` LabelingJobOutputConfig
outputConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HumanTaskConfig
humanTaskConfig

instance Prelude.NFData CreateLabelingJob where
  rnf :: CreateLabelingJob -> ()
rnf CreateLabelingJob' {Maybe [Tag]
Maybe Text
Maybe LabelingJobStoppingConditions
Maybe LabelingJobAlgorithmsConfig
Text
LabelingJobOutputConfig
LabelingJobInputConfig
HumanTaskConfig
humanTaskConfig :: HumanTaskConfig
roleArn :: Text
outputConfig :: LabelingJobOutputConfig
inputConfig :: LabelingJobInputConfig
labelAttributeName :: Text
labelingJobName :: Text
tags :: Maybe [Tag]
stoppingConditions :: Maybe LabelingJobStoppingConditions
labelingJobAlgorithmsConfig :: Maybe LabelingJobAlgorithmsConfig
labelCategoryConfigS3Uri :: Maybe Text
$sel:humanTaskConfig:CreateLabelingJob' :: CreateLabelingJob -> HumanTaskConfig
$sel:roleArn:CreateLabelingJob' :: CreateLabelingJob -> Text
$sel:outputConfig:CreateLabelingJob' :: CreateLabelingJob -> LabelingJobOutputConfig
$sel:inputConfig:CreateLabelingJob' :: CreateLabelingJob -> LabelingJobInputConfig
$sel:labelAttributeName:CreateLabelingJob' :: CreateLabelingJob -> Text
$sel:labelingJobName:CreateLabelingJob' :: CreateLabelingJob -> Text
$sel:tags:CreateLabelingJob' :: CreateLabelingJob -> Maybe [Tag]
$sel:stoppingConditions:CreateLabelingJob' :: CreateLabelingJob -> Maybe LabelingJobStoppingConditions
$sel:labelingJobAlgorithmsConfig:CreateLabelingJob' :: CreateLabelingJob -> Maybe LabelingJobAlgorithmsConfig
$sel:labelCategoryConfigS3Uri:CreateLabelingJob' :: CreateLabelingJob -> Maybe Text
..} =
    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 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 Text
labelingJobName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
labelAttributeName
      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

instance Data.ToHeaders CreateLabelingJob where
  toHeaders :: CreateLabelingJob -> 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.CreateLabelingJob" ::
                          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 CreateLabelingJob where
  toJSON :: CreateLabelingJob -> Value
toJSON CreateLabelingJob' {Maybe [Tag]
Maybe Text
Maybe LabelingJobStoppingConditions
Maybe LabelingJobAlgorithmsConfig
Text
LabelingJobOutputConfig
LabelingJobInputConfig
HumanTaskConfig
humanTaskConfig :: HumanTaskConfig
roleArn :: Text
outputConfig :: LabelingJobOutputConfig
inputConfig :: LabelingJobInputConfig
labelAttributeName :: Text
labelingJobName :: Text
tags :: Maybe [Tag]
stoppingConditions :: Maybe LabelingJobStoppingConditions
labelingJobAlgorithmsConfig :: Maybe LabelingJobAlgorithmsConfig
labelCategoryConfigS3Uri :: Maybe Text
$sel:humanTaskConfig:CreateLabelingJob' :: CreateLabelingJob -> HumanTaskConfig
$sel:roleArn:CreateLabelingJob' :: CreateLabelingJob -> Text
$sel:outputConfig:CreateLabelingJob' :: CreateLabelingJob -> LabelingJobOutputConfig
$sel:inputConfig:CreateLabelingJob' :: CreateLabelingJob -> LabelingJobInputConfig
$sel:labelAttributeName:CreateLabelingJob' :: CreateLabelingJob -> Text
$sel:labelingJobName:CreateLabelingJob' :: CreateLabelingJob -> Text
$sel:tags:CreateLabelingJob' :: CreateLabelingJob -> Maybe [Tag]
$sel:stoppingConditions:CreateLabelingJob' :: CreateLabelingJob -> Maybe LabelingJobStoppingConditions
$sel:labelingJobAlgorithmsConfig:CreateLabelingJob' :: CreateLabelingJob -> Maybe LabelingJobAlgorithmsConfig
$sel:labelCategoryConfigS3Uri:CreateLabelingJob' :: CreateLabelingJob -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"LabelCategoryConfigS3Uri" 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
labelCategoryConfigS3Uri,
            (Key
"LabelingJobAlgorithmsConfig" 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 LabelingJobAlgorithmsConfig
labelingJobAlgorithmsConfig,
            (Key
"StoppingConditions" 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 LabelingJobStoppingConditions
stoppingConditions,
            (Key
"Tags" 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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"LabelingJobName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
labelingJobName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"LabelAttributeName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
labelAttributeName),
            forall a. a -> Maybe a
Prelude.Just (Key
"InputConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= LabelingJobInputConfig
inputConfig),
            forall a. a -> Maybe a
Prelude.Just (Key
"OutputConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= LabelingJobOutputConfig
outputConfig),
            forall a. a -> Maybe a
Prelude.Just (Key
"RoleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
roleArn),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"HumanTaskConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= HumanTaskConfig
humanTaskConfig)
          ]
      )

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

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

-- | /See:/ 'newCreateLabelingJobResponse' smart constructor.
data CreateLabelingJobResponse = CreateLabelingJobResponse'
  { -- | The response's http status code.
    CreateLabelingJobResponse -> Int
httpStatus :: Prelude.Int,
    -- | The Amazon Resource Name (ARN) of the labeling job. You use this ARN to
    -- identify the labeling job.
    CreateLabelingJobResponse -> Text
labelingJobArn :: Prelude.Text
  }
  deriving (CreateLabelingJobResponse -> CreateLabelingJobResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLabelingJobResponse -> CreateLabelingJobResponse -> Bool
$c/= :: CreateLabelingJobResponse -> CreateLabelingJobResponse -> Bool
== :: CreateLabelingJobResponse -> CreateLabelingJobResponse -> Bool
$c== :: CreateLabelingJobResponse -> CreateLabelingJobResponse -> Bool
Prelude.Eq, ReadPrec [CreateLabelingJobResponse]
ReadPrec CreateLabelingJobResponse
Int -> ReadS CreateLabelingJobResponse
ReadS [CreateLabelingJobResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLabelingJobResponse]
$creadListPrec :: ReadPrec [CreateLabelingJobResponse]
readPrec :: ReadPrec CreateLabelingJobResponse
$creadPrec :: ReadPrec CreateLabelingJobResponse
readList :: ReadS [CreateLabelingJobResponse]
$creadList :: ReadS [CreateLabelingJobResponse]
readsPrec :: Int -> ReadS CreateLabelingJobResponse
$creadsPrec :: Int -> ReadS CreateLabelingJobResponse
Prelude.Read, Int -> CreateLabelingJobResponse -> ShowS
[CreateLabelingJobResponse] -> ShowS
CreateLabelingJobResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLabelingJobResponse] -> ShowS
$cshowList :: [CreateLabelingJobResponse] -> ShowS
show :: CreateLabelingJobResponse -> String
$cshow :: CreateLabelingJobResponse -> String
showsPrec :: Int -> CreateLabelingJobResponse -> ShowS
$cshowsPrec :: Int -> CreateLabelingJobResponse -> ShowS
Prelude.Show, forall x.
Rep CreateLabelingJobResponse x -> CreateLabelingJobResponse
forall x.
CreateLabelingJobResponse -> Rep CreateLabelingJobResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateLabelingJobResponse x -> CreateLabelingJobResponse
$cfrom :: forall x.
CreateLabelingJobResponse -> Rep CreateLabelingJobResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateLabelingJobResponse' 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:
--
-- 'httpStatus', 'createLabelingJobResponse_httpStatus' - The response's http status code.
--
-- 'labelingJobArn', 'createLabelingJobResponse_labelingJobArn' - The Amazon Resource Name (ARN) of the labeling job. You use this ARN to
-- identify the labeling job.
newCreateLabelingJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'labelingJobArn'
  Prelude.Text ->
  CreateLabelingJobResponse
newCreateLabelingJobResponse :: Int -> Text -> CreateLabelingJobResponse
newCreateLabelingJobResponse
  Int
pHttpStatus_
  Text
pLabelingJobArn_ =
    CreateLabelingJobResponse'
      { $sel:httpStatus:CreateLabelingJobResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:labelingJobArn:CreateLabelingJobResponse' :: Text
labelingJobArn = Text
pLabelingJobArn_
      }

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

-- | The Amazon Resource Name (ARN) of the labeling job. You use this ARN to
-- identify the labeling job.
createLabelingJobResponse_labelingJobArn :: Lens.Lens' CreateLabelingJobResponse Prelude.Text
createLabelingJobResponse_labelingJobArn :: Lens' CreateLabelingJobResponse Text
createLabelingJobResponse_labelingJobArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLabelingJobResponse' {Text
labelingJobArn :: Text
$sel:labelingJobArn:CreateLabelingJobResponse' :: CreateLabelingJobResponse -> Text
labelingJobArn} -> Text
labelingJobArn) (\s :: CreateLabelingJobResponse
s@CreateLabelingJobResponse' {} Text
a -> CreateLabelingJobResponse
s {$sel:labelingJobArn:CreateLabelingJobResponse' :: Text
labelingJobArn = Text
a} :: CreateLabelingJobResponse)

instance Prelude.NFData CreateLabelingJobResponse where
  rnf :: CreateLabelingJobResponse -> ()
rnf CreateLabelingJobResponse' {Int
Text
labelingJobArn :: Text
httpStatus :: Int
$sel:labelingJobArn:CreateLabelingJobResponse' :: CreateLabelingJobResponse -> Text
$sel:httpStatus:CreateLabelingJobResponse' :: CreateLabelingJobResponse -> Int
..} =
    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 Text
labelingJobArn