{-# 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.CreateTransformJob
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Starts a transform job. A transform job uses a trained model to get
-- inferences on a dataset and saves these results to an Amazon S3 location
-- that you specify.
--
-- To perform batch transformations, you create a transform job and use the
-- data that you have readily available.
--
-- In the request body, you provide the following:
--
-- -   @TransformJobName@ - Identifies the transform job. The name must be
--     unique within an Amazon Web Services Region in an Amazon Web
--     Services account.
--
-- -   @ModelName@ - Identifies the model to use. @ModelName@ must be the
--     name of an existing Amazon SageMaker model in the same Amazon Web
--     Services Region and Amazon Web Services account. For information on
--     creating a model, see
--     <https://docs.aws.amazon.com/sagemaker/latest/APIReference/API_CreateModel.html CreateModel>.
--
-- -   @TransformInput@ - Describes the dataset to be transformed and the
--     Amazon S3 location where it is stored.
--
-- -   @TransformOutput@ - Identifies the Amazon S3 location where you want
--     Amazon SageMaker to save the results from the transform job.
--
-- -   @TransformResources@ - Identifies the ML compute instances for the
--     transform job.
--
-- For more information about how batch transformation works, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/batch-transform.html Batch Transform>.
module Amazonka.SageMaker.CreateTransformJob
  ( -- * Creating a Request
    CreateTransformJob (..),
    newCreateTransformJob,

    -- * Request Lenses
    createTransformJob_batchStrategy,
    createTransformJob_dataCaptureConfig,
    createTransformJob_dataProcessing,
    createTransformJob_environment,
    createTransformJob_experimentConfig,
    createTransformJob_maxConcurrentTransforms,
    createTransformJob_maxPayloadInMB,
    createTransformJob_modelClientConfig,
    createTransformJob_tags,
    createTransformJob_transformJobName,
    createTransformJob_modelName,
    createTransformJob_transformInput,
    createTransformJob_transformOutput,
    createTransformJob_transformResources,

    -- * Destructuring the Response
    CreateTransformJobResponse (..),
    newCreateTransformJobResponse,

    -- * Response Lenses
    createTransformJobResponse_httpStatus,
    createTransformJobResponse_transformJobArn,
  )
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:/ 'newCreateTransformJob' smart constructor.
data CreateTransformJob = CreateTransformJob'
  { -- | Specifies the number of records to include in a mini-batch for an HTTP
    -- inference request. A /record/ // is a single unit of input data that
    -- inference can be made on. For example, a single line in a CSV file is a
    -- record.
    --
    -- To enable the batch strategy, you must set the @SplitType@ property to
    -- @Line@, @RecordIO@, or @TFRecord@.
    --
    -- To use only one record when making an HTTP invocation request to a
    -- container, set @BatchStrategy@ to @SingleRecord@ and @SplitType@ to
    -- @Line@.
    --
    -- To fit as many records in a mini-batch as can fit within the
    -- @MaxPayloadInMB@ limit, set @BatchStrategy@ to @MultiRecord@ and
    -- @SplitType@ to @Line@.
    CreateTransformJob -> Maybe BatchStrategy
batchStrategy :: Prelude.Maybe BatchStrategy,
    -- | Configuration to control how SageMaker captures inference data.
    CreateTransformJob -> Maybe BatchDataCaptureConfig
dataCaptureConfig :: Prelude.Maybe BatchDataCaptureConfig,
    -- | The data structure used to specify the data to be used for inference in
    -- a batch transform job and to associate the data that is relevant to the
    -- prediction results in the output. The input filter provided allows you
    -- to exclude input data that is not needed for inference in a batch
    -- transform job. The output filter provided allows you to include input
    -- data relevant to interpreting the predictions in the output from the
    -- job. For more information, see
    -- <https://docs.aws.amazon.com/sagemaker/latest/dg/batch-transform-data-processing.html Associate Prediction Results with their Corresponding Input Records>.
    CreateTransformJob -> Maybe DataProcessing
dataProcessing :: Prelude.Maybe DataProcessing,
    -- | The environment variables to set in the Docker container. We support up
    -- to 16 key and values entries in the map.
    CreateTransformJob -> Maybe (HashMap Text Text)
environment :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    CreateTransformJob -> Maybe ExperimentConfig
experimentConfig :: Prelude.Maybe ExperimentConfig,
    -- | The maximum number of parallel requests that can be sent to each
    -- instance in a transform job. If @MaxConcurrentTransforms@ is set to @0@
    -- or left unset, Amazon SageMaker checks the optional execution-parameters
    -- to determine the settings for your chosen algorithm. If the
    -- execution-parameters endpoint is not enabled, the default value is @1@.
    -- For more information on execution-parameters, see
    -- <https://docs.aws.amazon.com/sagemaker/latest/dg/your-algorithms-batch-code.html#your-algorithms-batch-code-how-containe-serves-requests How Containers Serve Requests>.
    -- For built-in algorithms, you don\'t need to set a value for
    -- @MaxConcurrentTransforms@.
    CreateTransformJob -> Maybe Natural
maxConcurrentTransforms :: Prelude.Maybe Prelude.Natural,
    -- | The maximum allowed size of the payload, in MB. A /payload/ is the data
    -- portion of a record (without metadata). The value in @MaxPayloadInMB@
    -- must be greater than, or equal to, the size of a single record. To
    -- estimate the size of a record in MB, divide the size of your dataset by
    -- the number of records. To ensure that the records fit within the maximum
    -- payload size, we recommend using a slightly larger value. The default
    -- value is @6@ MB.
    --
    -- The value of @MaxPayloadInMB@ cannot be greater than 100 MB. If you
    -- specify the @MaxConcurrentTransforms@ parameter, the value of
    -- @(MaxConcurrentTransforms * MaxPayloadInMB)@ also cannot exceed 100 MB.
    --
    -- For cases where the payload might be arbitrarily large and is
    -- transmitted using HTTP chunked encoding, set the value to @0@. This
    -- feature works only in supported algorithms. Currently, Amazon SageMaker
    -- built-in algorithms do not support HTTP chunked encoding.
    CreateTransformJob -> Maybe Natural
maxPayloadInMB :: Prelude.Maybe Prelude.Natural,
    -- | Configures the timeout and maximum number of retries for processing a
    -- transform job invocation.
    CreateTransformJob -> Maybe ModelClientConfig
modelClientConfig :: Prelude.Maybe ModelClientConfig,
    -- | (Optional) 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/.
    CreateTransformJob -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name of the transform job. The name must be unique within an Amazon
    -- Web Services Region in an Amazon Web Services account.
    CreateTransformJob -> Text
transformJobName :: Prelude.Text,
    -- | The name of the model that you want to use for the transform job.
    -- @ModelName@ must be the name of an existing Amazon SageMaker model
    -- within an Amazon Web Services Region in an Amazon Web Services account.
    CreateTransformJob -> Text
modelName :: Prelude.Text,
    -- | Describes the input source and the way the transform job consumes it.
    CreateTransformJob -> TransformInput
transformInput :: TransformInput,
    -- | Describes the results of the transform job.
    CreateTransformJob -> TransformOutput
transformOutput :: TransformOutput,
    -- | Describes the resources, including ML instance types and ML instance
    -- count, to use for the transform job.
    CreateTransformJob -> TransformResources
transformResources :: TransformResources
  }
  deriving (CreateTransformJob -> CreateTransformJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateTransformJob -> CreateTransformJob -> Bool
$c/= :: CreateTransformJob -> CreateTransformJob -> Bool
== :: CreateTransformJob -> CreateTransformJob -> Bool
$c== :: CreateTransformJob -> CreateTransformJob -> Bool
Prelude.Eq, ReadPrec [CreateTransformJob]
ReadPrec CreateTransformJob
Int -> ReadS CreateTransformJob
ReadS [CreateTransformJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateTransformJob]
$creadListPrec :: ReadPrec [CreateTransformJob]
readPrec :: ReadPrec CreateTransformJob
$creadPrec :: ReadPrec CreateTransformJob
readList :: ReadS [CreateTransformJob]
$creadList :: ReadS [CreateTransformJob]
readsPrec :: Int -> ReadS CreateTransformJob
$creadsPrec :: Int -> ReadS CreateTransformJob
Prelude.Read, Int -> CreateTransformJob -> ShowS
[CreateTransformJob] -> ShowS
CreateTransformJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateTransformJob] -> ShowS
$cshowList :: [CreateTransformJob] -> ShowS
show :: CreateTransformJob -> String
$cshow :: CreateTransformJob -> String
showsPrec :: Int -> CreateTransformJob -> ShowS
$cshowsPrec :: Int -> CreateTransformJob -> ShowS
Prelude.Show, forall x. Rep CreateTransformJob x -> CreateTransformJob
forall x. CreateTransformJob -> Rep CreateTransformJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateTransformJob x -> CreateTransformJob
$cfrom :: forall x. CreateTransformJob -> Rep CreateTransformJob x
Prelude.Generic)

-- |
-- Create a value of 'CreateTransformJob' 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:
--
-- 'batchStrategy', 'createTransformJob_batchStrategy' - Specifies the number of records to include in a mini-batch for an HTTP
-- inference request. A /record/ // is a single unit of input data that
-- inference can be made on. For example, a single line in a CSV file is a
-- record.
--
-- To enable the batch strategy, you must set the @SplitType@ property to
-- @Line@, @RecordIO@, or @TFRecord@.
--
-- To use only one record when making an HTTP invocation request to a
-- container, set @BatchStrategy@ to @SingleRecord@ and @SplitType@ to
-- @Line@.
--
-- To fit as many records in a mini-batch as can fit within the
-- @MaxPayloadInMB@ limit, set @BatchStrategy@ to @MultiRecord@ and
-- @SplitType@ to @Line@.
--
-- 'dataCaptureConfig', 'createTransformJob_dataCaptureConfig' - Configuration to control how SageMaker captures inference data.
--
-- 'dataProcessing', 'createTransformJob_dataProcessing' - The data structure used to specify the data to be used for inference in
-- a batch transform job and to associate the data that is relevant to the
-- prediction results in the output. The input filter provided allows you
-- to exclude input data that is not needed for inference in a batch
-- transform job. The output filter provided allows you to include input
-- data relevant to interpreting the predictions in the output from the
-- job. For more information, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/batch-transform-data-processing.html Associate Prediction Results with their Corresponding Input Records>.
--
-- 'environment', 'createTransformJob_environment' - The environment variables to set in the Docker container. We support up
-- to 16 key and values entries in the map.
--
-- 'experimentConfig', 'createTransformJob_experimentConfig' - Undocumented member.
--
-- 'maxConcurrentTransforms', 'createTransformJob_maxConcurrentTransforms' - The maximum number of parallel requests that can be sent to each
-- instance in a transform job. If @MaxConcurrentTransforms@ is set to @0@
-- or left unset, Amazon SageMaker checks the optional execution-parameters
-- to determine the settings for your chosen algorithm. If the
-- execution-parameters endpoint is not enabled, the default value is @1@.
-- For more information on execution-parameters, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/your-algorithms-batch-code.html#your-algorithms-batch-code-how-containe-serves-requests How Containers Serve Requests>.
-- For built-in algorithms, you don\'t need to set a value for
-- @MaxConcurrentTransforms@.
--
-- 'maxPayloadInMB', 'createTransformJob_maxPayloadInMB' - The maximum allowed size of the payload, in MB. A /payload/ is the data
-- portion of a record (without metadata). The value in @MaxPayloadInMB@
-- must be greater than, or equal to, the size of a single record. To
-- estimate the size of a record in MB, divide the size of your dataset by
-- the number of records. To ensure that the records fit within the maximum
-- payload size, we recommend using a slightly larger value. The default
-- value is @6@ MB.
--
-- The value of @MaxPayloadInMB@ cannot be greater than 100 MB. If you
-- specify the @MaxConcurrentTransforms@ parameter, the value of
-- @(MaxConcurrentTransforms * MaxPayloadInMB)@ also cannot exceed 100 MB.
--
-- For cases where the payload might be arbitrarily large and is
-- transmitted using HTTP chunked encoding, set the value to @0@. This
-- feature works only in supported algorithms. Currently, Amazon SageMaker
-- built-in algorithms do not support HTTP chunked encoding.
--
-- 'modelClientConfig', 'createTransformJob_modelClientConfig' - Configures the timeout and maximum number of retries for processing a
-- transform job invocation.
--
-- 'tags', 'createTransformJob_tags' - (Optional) 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/.
--
-- 'transformJobName', 'createTransformJob_transformJobName' - The name of the transform job. The name must be unique within an Amazon
-- Web Services Region in an Amazon Web Services account.
--
-- 'modelName', 'createTransformJob_modelName' - The name of the model that you want to use for the transform job.
-- @ModelName@ must be the name of an existing Amazon SageMaker model
-- within an Amazon Web Services Region in an Amazon Web Services account.
--
-- 'transformInput', 'createTransformJob_transformInput' - Describes the input source and the way the transform job consumes it.
--
-- 'transformOutput', 'createTransformJob_transformOutput' - Describes the results of the transform job.
--
-- 'transformResources', 'createTransformJob_transformResources' - Describes the resources, including ML instance types and ML instance
-- count, to use for the transform job.
newCreateTransformJob ::
  -- | 'transformJobName'
  Prelude.Text ->
  -- | 'modelName'
  Prelude.Text ->
  -- | 'transformInput'
  TransformInput ->
  -- | 'transformOutput'
  TransformOutput ->
  -- | 'transformResources'
  TransformResources ->
  CreateTransformJob
newCreateTransformJob :: Text
-> Text
-> TransformInput
-> TransformOutput
-> TransformResources
-> CreateTransformJob
newCreateTransformJob
  Text
pTransformJobName_
  Text
pModelName_
  TransformInput
pTransformInput_
  TransformOutput
pTransformOutput_
  TransformResources
pTransformResources_ =
    CreateTransformJob'
      { $sel:batchStrategy:CreateTransformJob' :: Maybe BatchStrategy
batchStrategy =
          forall a. Maybe a
Prelude.Nothing,
        $sel:dataCaptureConfig:CreateTransformJob' :: Maybe BatchDataCaptureConfig
dataCaptureConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:dataProcessing:CreateTransformJob' :: Maybe DataProcessing
dataProcessing = forall a. Maybe a
Prelude.Nothing,
        $sel:environment:CreateTransformJob' :: Maybe (HashMap Text Text)
environment = forall a. Maybe a
Prelude.Nothing,
        $sel:experimentConfig:CreateTransformJob' :: Maybe ExperimentConfig
experimentConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:maxConcurrentTransforms:CreateTransformJob' :: Maybe Natural
maxConcurrentTransforms = forall a. Maybe a
Prelude.Nothing,
        $sel:maxPayloadInMB:CreateTransformJob' :: Maybe Natural
maxPayloadInMB = forall a. Maybe a
Prelude.Nothing,
        $sel:modelClientConfig:CreateTransformJob' :: Maybe ModelClientConfig
modelClientConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateTransformJob' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:transformJobName:CreateTransformJob' :: Text
transformJobName = Text
pTransformJobName_,
        $sel:modelName:CreateTransformJob' :: Text
modelName = Text
pModelName_,
        $sel:transformInput:CreateTransformJob' :: TransformInput
transformInput = TransformInput
pTransformInput_,
        $sel:transformOutput:CreateTransformJob' :: TransformOutput
transformOutput = TransformOutput
pTransformOutput_,
        $sel:transformResources:CreateTransformJob' :: TransformResources
transformResources = TransformResources
pTransformResources_
      }

-- | Specifies the number of records to include in a mini-batch for an HTTP
-- inference request. A /record/ // is a single unit of input data that
-- inference can be made on. For example, a single line in a CSV file is a
-- record.
--
-- To enable the batch strategy, you must set the @SplitType@ property to
-- @Line@, @RecordIO@, or @TFRecord@.
--
-- To use only one record when making an HTTP invocation request to a
-- container, set @BatchStrategy@ to @SingleRecord@ and @SplitType@ to
-- @Line@.
--
-- To fit as many records in a mini-batch as can fit within the
-- @MaxPayloadInMB@ limit, set @BatchStrategy@ to @MultiRecord@ and
-- @SplitType@ to @Line@.
createTransformJob_batchStrategy :: Lens.Lens' CreateTransformJob (Prelude.Maybe BatchStrategy)
createTransformJob_batchStrategy :: Lens' CreateTransformJob (Maybe BatchStrategy)
createTransformJob_batchStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransformJob' {Maybe BatchStrategy
batchStrategy :: Maybe BatchStrategy
$sel:batchStrategy:CreateTransformJob' :: CreateTransformJob -> Maybe BatchStrategy
batchStrategy} -> Maybe BatchStrategy
batchStrategy) (\s :: CreateTransformJob
s@CreateTransformJob' {} Maybe BatchStrategy
a -> CreateTransformJob
s {$sel:batchStrategy:CreateTransformJob' :: Maybe BatchStrategy
batchStrategy = Maybe BatchStrategy
a} :: CreateTransformJob)

-- | Configuration to control how SageMaker captures inference data.
createTransformJob_dataCaptureConfig :: Lens.Lens' CreateTransformJob (Prelude.Maybe BatchDataCaptureConfig)
createTransformJob_dataCaptureConfig :: Lens' CreateTransformJob (Maybe BatchDataCaptureConfig)
createTransformJob_dataCaptureConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransformJob' {Maybe BatchDataCaptureConfig
dataCaptureConfig :: Maybe BatchDataCaptureConfig
$sel:dataCaptureConfig:CreateTransformJob' :: CreateTransformJob -> Maybe BatchDataCaptureConfig
dataCaptureConfig} -> Maybe BatchDataCaptureConfig
dataCaptureConfig) (\s :: CreateTransformJob
s@CreateTransformJob' {} Maybe BatchDataCaptureConfig
a -> CreateTransformJob
s {$sel:dataCaptureConfig:CreateTransformJob' :: Maybe BatchDataCaptureConfig
dataCaptureConfig = Maybe BatchDataCaptureConfig
a} :: CreateTransformJob)

-- | The data structure used to specify the data to be used for inference in
-- a batch transform job and to associate the data that is relevant to the
-- prediction results in the output. The input filter provided allows you
-- to exclude input data that is not needed for inference in a batch
-- transform job. The output filter provided allows you to include input
-- data relevant to interpreting the predictions in the output from the
-- job. For more information, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/batch-transform-data-processing.html Associate Prediction Results with their Corresponding Input Records>.
createTransformJob_dataProcessing :: Lens.Lens' CreateTransformJob (Prelude.Maybe DataProcessing)
createTransformJob_dataProcessing :: Lens' CreateTransformJob (Maybe DataProcessing)
createTransformJob_dataProcessing = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransformJob' {Maybe DataProcessing
dataProcessing :: Maybe DataProcessing
$sel:dataProcessing:CreateTransformJob' :: CreateTransformJob -> Maybe DataProcessing
dataProcessing} -> Maybe DataProcessing
dataProcessing) (\s :: CreateTransformJob
s@CreateTransformJob' {} Maybe DataProcessing
a -> CreateTransformJob
s {$sel:dataProcessing:CreateTransformJob' :: Maybe DataProcessing
dataProcessing = Maybe DataProcessing
a} :: CreateTransformJob)

-- | The environment variables to set in the Docker container. We support up
-- to 16 key and values entries in the map.
createTransformJob_environment :: Lens.Lens' CreateTransformJob (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createTransformJob_environment :: Lens' CreateTransformJob (Maybe (HashMap Text Text))
createTransformJob_environment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransformJob' {Maybe (HashMap Text Text)
environment :: Maybe (HashMap Text Text)
$sel:environment:CreateTransformJob' :: CreateTransformJob -> Maybe (HashMap Text Text)
environment} -> Maybe (HashMap Text Text)
environment) (\s :: CreateTransformJob
s@CreateTransformJob' {} Maybe (HashMap Text Text)
a -> CreateTransformJob
s {$sel:environment:CreateTransformJob' :: Maybe (HashMap Text Text)
environment = Maybe (HashMap Text Text)
a} :: CreateTransformJob) 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

-- | Undocumented member.
createTransformJob_experimentConfig :: Lens.Lens' CreateTransformJob (Prelude.Maybe ExperimentConfig)
createTransformJob_experimentConfig :: Lens' CreateTransformJob (Maybe ExperimentConfig)
createTransformJob_experimentConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransformJob' {Maybe ExperimentConfig
experimentConfig :: Maybe ExperimentConfig
$sel:experimentConfig:CreateTransformJob' :: CreateTransformJob -> Maybe ExperimentConfig
experimentConfig} -> Maybe ExperimentConfig
experimentConfig) (\s :: CreateTransformJob
s@CreateTransformJob' {} Maybe ExperimentConfig
a -> CreateTransformJob
s {$sel:experimentConfig:CreateTransformJob' :: Maybe ExperimentConfig
experimentConfig = Maybe ExperimentConfig
a} :: CreateTransformJob)

-- | The maximum number of parallel requests that can be sent to each
-- instance in a transform job. If @MaxConcurrentTransforms@ is set to @0@
-- or left unset, Amazon SageMaker checks the optional execution-parameters
-- to determine the settings for your chosen algorithm. If the
-- execution-parameters endpoint is not enabled, the default value is @1@.
-- For more information on execution-parameters, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/your-algorithms-batch-code.html#your-algorithms-batch-code-how-containe-serves-requests How Containers Serve Requests>.
-- For built-in algorithms, you don\'t need to set a value for
-- @MaxConcurrentTransforms@.
createTransformJob_maxConcurrentTransforms :: Lens.Lens' CreateTransformJob (Prelude.Maybe Prelude.Natural)
createTransformJob_maxConcurrentTransforms :: Lens' CreateTransformJob (Maybe Natural)
createTransformJob_maxConcurrentTransforms = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransformJob' {Maybe Natural
maxConcurrentTransforms :: Maybe Natural
$sel:maxConcurrentTransforms:CreateTransformJob' :: CreateTransformJob -> Maybe Natural
maxConcurrentTransforms} -> Maybe Natural
maxConcurrentTransforms) (\s :: CreateTransformJob
s@CreateTransformJob' {} Maybe Natural
a -> CreateTransformJob
s {$sel:maxConcurrentTransforms:CreateTransformJob' :: Maybe Natural
maxConcurrentTransforms = Maybe Natural
a} :: CreateTransformJob)

-- | The maximum allowed size of the payload, in MB. A /payload/ is the data
-- portion of a record (without metadata). The value in @MaxPayloadInMB@
-- must be greater than, or equal to, the size of a single record. To
-- estimate the size of a record in MB, divide the size of your dataset by
-- the number of records. To ensure that the records fit within the maximum
-- payload size, we recommend using a slightly larger value. The default
-- value is @6@ MB.
--
-- The value of @MaxPayloadInMB@ cannot be greater than 100 MB. If you
-- specify the @MaxConcurrentTransforms@ parameter, the value of
-- @(MaxConcurrentTransforms * MaxPayloadInMB)@ also cannot exceed 100 MB.
--
-- For cases where the payload might be arbitrarily large and is
-- transmitted using HTTP chunked encoding, set the value to @0@. This
-- feature works only in supported algorithms. Currently, Amazon SageMaker
-- built-in algorithms do not support HTTP chunked encoding.
createTransformJob_maxPayloadInMB :: Lens.Lens' CreateTransformJob (Prelude.Maybe Prelude.Natural)
createTransformJob_maxPayloadInMB :: Lens' CreateTransformJob (Maybe Natural)
createTransformJob_maxPayloadInMB = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransformJob' {Maybe Natural
maxPayloadInMB :: Maybe Natural
$sel:maxPayloadInMB:CreateTransformJob' :: CreateTransformJob -> Maybe Natural
maxPayloadInMB} -> Maybe Natural
maxPayloadInMB) (\s :: CreateTransformJob
s@CreateTransformJob' {} Maybe Natural
a -> CreateTransformJob
s {$sel:maxPayloadInMB:CreateTransformJob' :: Maybe Natural
maxPayloadInMB = Maybe Natural
a} :: CreateTransformJob)

-- | Configures the timeout and maximum number of retries for processing a
-- transform job invocation.
createTransformJob_modelClientConfig :: Lens.Lens' CreateTransformJob (Prelude.Maybe ModelClientConfig)
createTransformJob_modelClientConfig :: Lens' CreateTransformJob (Maybe ModelClientConfig)
createTransformJob_modelClientConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransformJob' {Maybe ModelClientConfig
modelClientConfig :: Maybe ModelClientConfig
$sel:modelClientConfig:CreateTransformJob' :: CreateTransformJob -> Maybe ModelClientConfig
modelClientConfig} -> Maybe ModelClientConfig
modelClientConfig) (\s :: CreateTransformJob
s@CreateTransformJob' {} Maybe ModelClientConfig
a -> CreateTransformJob
s {$sel:modelClientConfig:CreateTransformJob' :: Maybe ModelClientConfig
modelClientConfig = Maybe ModelClientConfig
a} :: CreateTransformJob)

-- | (Optional) 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/.
createTransformJob_tags :: Lens.Lens' CreateTransformJob (Prelude.Maybe [Tag])
createTransformJob_tags :: Lens' CreateTransformJob (Maybe [Tag])
createTransformJob_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransformJob' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateTransformJob' :: CreateTransformJob -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateTransformJob
s@CreateTransformJob' {} Maybe [Tag]
a -> CreateTransformJob
s {$sel:tags:CreateTransformJob' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateTransformJob) 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 transform job. The name must be unique within an Amazon
-- Web Services Region in an Amazon Web Services account.
createTransformJob_transformJobName :: Lens.Lens' CreateTransformJob Prelude.Text
createTransformJob_transformJobName :: Lens' CreateTransformJob Text
createTransformJob_transformJobName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransformJob' {Text
transformJobName :: Text
$sel:transformJobName:CreateTransformJob' :: CreateTransformJob -> Text
transformJobName} -> Text
transformJobName) (\s :: CreateTransformJob
s@CreateTransformJob' {} Text
a -> CreateTransformJob
s {$sel:transformJobName:CreateTransformJob' :: Text
transformJobName = Text
a} :: CreateTransformJob)

-- | The name of the model that you want to use for the transform job.
-- @ModelName@ must be the name of an existing Amazon SageMaker model
-- within an Amazon Web Services Region in an Amazon Web Services account.
createTransformJob_modelName :: Lens.Lens' CreateTransformJob Prelude.Text
createTransformJob_modelName :: Lens' CreateTransformJob Text
createTransformJob_modelName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransformJob' {Text
modelName :: Text
$sel:modelName:CreateTransformJob' :: CreateTransformJob -> Text
modelName} -> Text
modelName) (\s :: CreateTransformJob
s@CreateTransformJob' {} Text
a -> CreateTransformJob
s {$sel:modelName:CreateTransformJob' :: Text
modelName = Text
a} :: CreateTransformJob)

-- | Describes the input source and the way the transform job consumes it.
createTransformJob_transformInput :: Lens.Lens' CreateTransformJob TransformInput
createTransformJob_transformInput :: Lens' CreateTransformJob TransformInput
createTransformJob_transformInput = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransformJob' {TransformInput
transformInput :: TransformInput
$sel:transformInput:CreateTransformJob' :: CreateTransformJob -> TransformInput
transformInput} -> TransformInput
transformInput) (\s :: CreateTransformJob
s@CreateTransformJob' {} TransformInput
a -> CreateTransformJob
s {$sel:transformInput:CreateTransformJob' :: TransformInput
transformInput = TransformInput
a} :: CreateTransformJob)

-- | Describes the results of the transform job.
createTransformJob_transformOutput :: Lens.Lens' CreateTransformJob TransformOutput
createTransformJob_transformOutput :: Lens' CreateTransformJob TransformOutput
createTransformJob_transformOutput = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransformJob' {TransformOutput
transformOutput :: TransformOutput
$sel:transformOutput:CreateTransformJob' :: CreateTransformJob -> TransformOutput
transformOutput} -> TransformOutput
transformOutput) (\s :: CreateTransformJob
s@CreateTransformJob' {} TransformOutput
a -> CreateTransformJob
s {$sel:transformOutput:CreateTransformJob' :: TransformOutput
transformOutput = TransformOutput
a} :: CreateTransformJob)

-- | Describes the resources, including ML instance types and ML instance
-- count, to use for the transform job.
createTransformJob_transformResources :: Lens.Lens' CreateTransformJob TransformResources
createTransformJob_transformResources :: Lens' CreateTransformJob TransformResources
createTransformJob_transformResources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTransformJob' {TransformResources
transformResources :: TransformResources
$sel:transformResources:CreateTransformJob' :: CreateTransformJob -> TransformResources
transformResources} -> TransformResources
transformResources) (\s :: CreateTransformJob
s@CreateTransformJob' {} TransformResources
a -> CreateTransformJob
s {$sel:transformResources:CreateTransformJob' :: TransformResources
transformResources = TransformResources
a} :: CreateTransformJob)

instance Core.AWSRequest CreateTransformJob where
  type
    AWSResponse CreateTransformJob =
      CreateTransformJobResponse
  request :: (Service -> Service)
-> CreateTransformJob -> Request CreateTransformJob
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 CreateTransformJob
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateTransformJob)))
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 -> CreateTransformJobResponse
CreateTransformJobResponse'
            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
"TransformJobArn")
      )

instance Prelude.Hashable CreateTransformJob where
  hashWithSalt :: Int -> CreateTransformJob -> Int
hashWithSalt Int
_salt CreateTransformJob' {Maybe Natural
Maybe [Tag]
Maybe (HashMap Text Text)
Maybe BatchDataCaptureConfig
Maybe BatchStrategy
Maybe ExperimentConfig
Maybe DataProcessing
Maybe ModelClientConfig
Text
TransformOutput
TransformResources
TransformInput
transformResources :: TransformResources
transformOutput :: TransformOutput
transformInput :: TransformInput
modelName :: Text
transformJobName :: Text
tags :: Maybe [Tag]
modelClientConfig :: Maybe ModelClientConfig
maxPayloadInMB :: Maybe Natural
maxConcurrentTransforms :: Maybe Natural
experimentConfig :: Maybe ExperimentConfig
environment :: Maybe (HashMap Text Text)
dataProcessing :: Maybe DataProcessing
dataCaptureConfig :: Maybe BatchDataCaptureConfig
batchStrategy :: Maybe BatchStrategy
$sel:transformResources:CreateTransformJob' :: CreateTransformJob -> TransformResources
$sel:transformOutput:CreateTransformJob' :: CreateTransformJob -> TransformOutput
$sel:transformInput:CreateTransformJob' :: CreateTransformJob -> TransformInput
$sel:modelName:CreateTransformJob' :: CreateTransformJob -> Text
$sel:transformJobName:CreateTransformJob' :: CreateTransformJob -> Text
$sel:tags:CreateTransformJob' :: CreateTransformJob -> Maybe [Tag]
$sel:modelClientConfig:CreateTransformJob' :: CreateTransformJob -> Maybe ModelClientConfig
$sel:maxPayloadInMB:CreateTransformJob' :: CreateTransformJob -> Maybe Natural
$sel:maxConcurrentTransforms:CreateTransformJob' :: CreateTransformJob -> Maybe Natural
$sel:experimentConfig:CreateTransformJob' :: CreateTransformJob -> Maybe ExperimentConfig
$sel:environment:CreateTransformJob' :: CreateTransformJob -> Maybe (HashMap Text Text)
$sel:dataProcessing:CreateTransformJob' :: CreateTransformJob -> Maybe DataProcessing
$sel:dataCaptureConfig:CreateTransformJob' :: CreateTransformJob -> Maybe BatchDataCaptureConfig
$sel:batchStrategy:CreateTransformJob' :: CreateTransformJob -> Maybe BatchStrategy
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BatchStrategy
batchStrategy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BatchDataCaptureConfig
dataCaptureConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DataProcessing
dataProcessing
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
environment
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ExperimentConfig
experimentConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxConcurrentTransforms
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxPayloadInMB
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ModelClientConfig
modelClientConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
transformJobName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
modelName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` TransformInput
transformInput
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` TransformOutput
transformOutput
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` TransformResources
transformResources

instance Prelude.NFData CreateTransformJob where
  rnf :: CreateTransformJob -> ()
rnf CreateTransformJob' {Maybe Natural
Maybe [Tag]
Maybe (HashMap Text Text)
Maybe BatchDataCaptureConfig
Maybe BatchStrategy
Maybe ExperimentConfig
Maybe DataProcessing
Maybe ModelClientConfig
Text
TransformOutput
TransformResources
TransformInput
transformResources :: TransformResources
transformOutput :: TransformOutput
transformInput :: TransformInput
modelName :: Text
transformJobName :: Text
tags :: Maybe [Tag]
modelClientConfig :: Maybe ModelClientConfig
maxPayloadInMB :: Maybe Natural
maxConcurrentTransforms :: Maybe Natural
experimentConfig :: Maybe ExperimentConfig
environment :: Maybe (HashMap Text Text)
dataProcessing :: Maybe DataProcessing
dataCaptureConfig :: Maybe BatchDataCaptureConfig
batchStrategy :: Maybe BatchStrategy
$sel:transformResources:CreateTransformJob' :: CreateTransformJob -> TransformResources
$sel:transformOutput:CreateTransformJob' :: CreateTransformJob -> TransformOutput
$sel:transformInput:CreateTransformJob' :: CreateTransformJob -> TransformInput
$sel:modelName:CreateTransformJob' :: CreateTransformJob -> Text
$sel:transformJobName:CreateTransformJob' :: CreateTransformJob -> Text
$sel:tags:CreateTransformJob' :: CreateTransformJob -> Maybe [Tag]
$sel:modelClientConfig:CreateTransformJob' :: CreateTransformJob -> Maybe ModelClientConfig
$sel:maxPayloadInMB:CreateTransformJob' :: CreateTransformJob -> Maybe Natural
$sel:maxConcurrentTransforms:CreateTransformJob' :: CreateTransformJob -> Maybe Natural
$sel:experimentConfig:CreateTransformJob' :: CreateTransformJob -> Maybe ExperimentConfig
$sel:environment:CreateTransformJob' :: CreateTransformJob -> Maybe (HashMap Text Text)
$sel:dataProcessing:CreateTransformJob' :: CreateTransformJob -> Maybe DataProcessing
$sel:dataCaptureConfig:CreateTransformJob' :: CreateTransformJob -> Maybe BatchDataCaptureConfig
$sel:batchStrategy:CreateTransformJob' :: CreateTransformJob -> Maybe BatchStrategy
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe BatchStrategy
batchStrategy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BatchDataCaptureConfig
dataCaptureConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DataProcessing
dataProcessing
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
environment
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ExperimentConfig
experimentConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxConcurrentTransforms
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxPayloadInMB
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ModelClientConfig
modelClientConfig
      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
transformJobName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
modelName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf TransformInput
transformInput
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf TransformOutput
transformOutput
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf TransformResources
transformResources

instance Data.ToHeaders CreateTransformJob where
  toHeaders :: CreateTransformJob -> 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.CreateTransformJob" ::
                          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 CreateTransformJob where
  toJSON :: CreateTransformJob -> Value
toJSON CreateTransformJob' {Maybe Natural
Maybe [Tag]
Maybe (HashMap Text Text)
Maybe BatchDataCaptureConfig
Maybe BatchStrategy
Maybe ExperimentConfig
Maybe DataProcessing
Maybe ModelClientConfig
Text
TransformOutput
TransformResources
TransformInput
transformResources :: TransformResources
transformOutput :: TransformOutput
transformInput :: TransformInput
modelName :: Text
transformJobName :: Text
tags :: Maybe [Tag]
modelClientConfig :: Maybe ModelClientConfig
maxPayloadInMB :: Maybe Natural
maxConcurrentTransforms :: Maybe Natural
experimentConfig :: Maybe ExperimentConfig
environment :: Maybe (HashMap Text Text)
dataProcessing :: Maybe DataProcessing
dataCaptureConfig :: Maybe BatchDataCaptureConfig
batchStrategy :: Maybe BatchStrategy
$sel:transformResources:CreateTransformJob' :: CreateTransformJob -> TransformResources
$sel:transformOutput:CreateTransformJob' :: CreateTransformJob -> TransformOutput
$sel:transformInput:CreateTransformJob' :: CreateTransformJob -> TransformInput
$sel:modelName:CreateTransformJob' :: CreateTransformJob -> Text
$sel:transformJobName:CreateTransformJob' :: CreateTransformJob -> Text
$sel:tags:CreateTransformJob' :: CreateTransformJob -> Maybe [Tag]
$sel:modelClientConfig:CreateTransformJob' :: CreateTransformJob -> Maybe ModelClientConfig
$sel:maxPayloadInMB:CreateTransformJob' :: CreateTransformJob -> Maybe Natural
$sel:maxConcurrentTransforms:CreateTransformJob' :: CreateTransformJob -> Maybe Natural
$sel:experimentConfig:CreateTransformJob' :: CreateTransformJob -> Maybe ExperimentConfig
$sel:environment:CreateTransformJob' :: CreateTransformJob -> Maybe (HashMap Text Text)
$sel:dataProcessing:CreateTransformJob' :: CreateTransformJob -> Maybe DataProcessing
$sel:dataCaptureConfig:CreateTransformJob' :: CreateTransformJob -> Maybe BatchDataCaptureConfig
$sel:batchStrategy:CreateTransformJob' :: CreateTransformJob -> Maybe BatchStrategy
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"BatchStrategy" 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 BatchStrategy
batchStrategy,
            (Key
"DataCaptureConfig" 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 BatchDataCaptureConfig
dataCaptureConfig,
            (Key
"DataProcessing" 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 DataProcessing
dataProcessing,
            (Key
"Environment" 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 (HashMap Text Text)
environment,
            (Key
"ExperimentConfig" 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 ExperimentConfig
experimentConfig,
            (Key
"MaxConcurrentTransforms" 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 Natural
maxConcurrentTransforms,
            (Key
"MaxPayloadInMB" 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 Natural
maxPayloadInMB,
            (Key
"ModelClientConfig" 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 ModelClientConfig
modelClientConfig,
            (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
"TransformJobName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
transformJobName),
            forall a. a -> Maybe a
Prelude.Just (Key
"ModelName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
modelName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"TransformInput" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= TransformInput
transformInput),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"TransformOutput" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= TransformOutput
transformOutput),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"TransformResources" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= TransformResources
transformResources)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateTransformJobResponse' 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', 'createTransformJobResponse_httpStatus' - The response's http status code.
--
-- 'transformJobArn', 'createTransformJobResponse_transformJobArn' - The Amazon Resource Name (ARN) of the transform job.
newCreateTransformJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'transformJobArn'
  Prelude.Text ->
  CreateTransformJobResponse
newCreateTransformJobResponse :: Int -> Text -> CreateTransformJobResponse
newCreateTransformJobResponse
  Int
pHttpStatus_
  Text
pTransformJobArn_ =
    CreateTransformJobResponse'
      { $sel:httpStatus:CreateTransformJobResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:transformJobArn:CreateTransformJobResponse' :: Text
transformJobArn = Text
pTransformJobArn_
      }

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

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

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