{-# 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.CreateTrainingJob
-- 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 model training job. After training completes, SageMaker saves
-- the resulting model artifacts to an Amazon S3 location that you specify.
--
-- If you choose to host your model using SageMaker hosting services, you
-- can use the resulting model artifacts as part of the model. You can also
-- use the artifacts in a machine learning service other than SageMaker,
-- provided that you know how to use them for inference.
--
-- In the request body, you provide the following:
--
-- -   @AlgorithmSpecification@ - Identifies the training algorithm to use.
--
-- -   @HyperParameters@ - Specify these algorithm-specific parameters to
--     enable the estimation of model parameters during training.
--     Hyperparameters can be tuned to optimize this learning process. For
--     a list of hyperparameters for each training algorithm provided by
--     SageMaker, see
--     <https://docs.aws.amazon.com/sagemaker/latest/dg/algos.html Algorithms>.
--
--     Do not include any security-sensitive information including account
--     access IDs, secrets or tokens in any hyperparameter field. If the
--     use of security-sensitive credentials are detected, SageMaker will
--     reject your training job request and return an exception error.
--
-- -   @InputDataConfig@ - Describes the input required by the training job
--     and the Amazon S3, EFS, or FSx location where it is stored.
--
-- -   @OutputDataConfig@ - Identifies the Amazon S3 bucket where you want
--     SageMaker to save the results of model training.
--
-- -   @ResourceConfig@ - Identifies the resources, ML compute instances,
--     and ML storage volumes to deploy for model training. In distributed
--     training, you specify more than one instance.
--
-- -   @EnableManagedSpotTraining@ - Optimize the cost of training machine
--     learning models by up to 80% by using Amazon EC2 Spot instances. For
--     more information, see
--     <https://docs.aws.amazon.com/sagemaker/latest/dg/model-managed-spot-training.html Managed Spot Training>.
--
-- -   @RoleArn@ - The Amazon Resource Name (ARN) that SageMaker assumes to
--     perform tasks on your behalf during model training. You must grant
--     this role the necessary permissions so that SageMaker can
--     successfully complete model training.
--
-- -   @StoppingCondition@ - To help cap training costs, use
--     @MaxRuntimeInSeconds@ to set a time limit for training. Use
--     @MaxWaitTimeInSeconds@ to specify how long a managed spot training
--     job has to complete.
--
-- -   @Environment@ - The environment variables to set in the Docker
--     container.
--
-- -   @RetryStrategy@ - The number of times to retry the job when the job
--     fails due to an @InternalServerError@.
--
-- For more information about SageMaker, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/how-it-works.html How It Works>.
module Amazonka.SageMaker.CreateTrainingJob
  ( -- * Creating a Request
    CreateTrainingJob (..),
    newCreateTrainingJob,

    -- * Request Lenses
    createTrainingJob_checkpointConfig,
    createTrainingJob_debugHookConfig,
    createTrainingJob_debugRuleConfigurations,
    createTrainingJob_enableInterContainerTrafficEncryption,
    createTrainingJob_enableManagedSpotTraining,
    createTrainingJob_enableNetworkIsolation,
    createTrainingJob_environment,
    createTrainingJob_experimentConfig,
    createTrainingJob_hyperParameters,
    createTrainingJob_inputDataConfig,
    createTrainingJob_profilerConfig,
    createTrainingJob_profilerRuleConfigurations,
    createTrainingJob_retryStrategy,
    createTrainingJob_tags,
    createTrainingJob_tensorBoardOutputConfig,
    createTrainingJob_vpcConfig,
    createTrainingJob_trainingJobName,
    createTrainingJob_algorithmSpecification,
    createTrainingJob_roleArn,
    createTrainingJob_outputDataConfig,
    createTrainingJob_resourceConfig,
    createTrainingJob_stoppingCondition,

    -- * Destructuring the Response
    CreateTrainingJobResponse (..),
    newCreateTrainingJobResponse,

    -- * Response Lenses
    createTrainingJobResponse_httpStatus,
    createTrainingJobResponse_trainingJobArn,
  )
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:/ 'newCreateTrainingJob' smart constructor.
data CreateTrainingJob = CreateTrainingJob'
  { -- | Contains information about the output location for managed spot training
    -- checkpoint data.
    CreateTrainingJob -> Maybe CheckpointConfig
checkpointConfig :: Prelude.Maybe CheckpointConfig,
    CreateTrainingJob -> Maybe DebugHookConfig
debugHookConfig :: Prelude.Maybe DebugHookConfig,
    -- | Configuration information for Amazon SageMaker Debugger rules for
    -- debugging output tensors.
    CreateTrainingJob -> Maybe [DebugRuleConfiguration]
debugRuleConfigurations :: Prelude.Maybe [DebugRuleConfiguration],
    -- | To encrypt all communications between ML compute instances in
    -- distributed training, choose @True@. Encryption provides greater
    -- security for distributed training, but training might take longer. How
    -- long it takes depends on the amount of communication between compute
    -- instances, especially if you use a deep learning algorithm in
    -- distributed training. For more information, see
    -- <https://docs.aws.amazon.com/sagemaker/latest/dg/train-encrypt.html Protect Communications Between ML Compute Instances in a Distributed Training Job>.
    CreateTrainingJob -> Maybe Bool
enableInterContainerTrafficEncryption :: Prelude.Maybe Prelude.Bool,
    -- | To train models using managed spot training, choose @True@. Managed spot
    -- training provides a fully managed and scalable infrastructure for
    -- training machine learning models. this option is useful when training
    -- jobs can be interrupted and when there is flexibility when the training
    -- job is run.
    --
    -- The complete and intermediate results of jobs are stored in an Amazon S3
    -- bucket, and can be used as a starting point to train models
    -- incrementally. Amazon SageMaker provides metrics and logs in CloudWatch.
    -- They can be used to see when managed spot training jobs are running,
    -- interrupted, resumed, or completed.
    CreateTrainingJob -> Maybe Bool
enableManagedSpotTraining :: Prelude.Maybe Prelude.Bool,
    -- | Isolates the training container. No inbound or outbound network calls
    -- can be made, except for calls between peers within a training cluster
    -- for distributed training. If you enable network isolation for training
    -- jobs that are configured to use a VPC, SageMaker downloads and uploads
    -- customer data and model artifacts through the specified VPC, but the
    -- training container does not have network access.
    CreateTrainingJob -> Maybe Bool
enableNetworkIsolation :: Prelude.Maybe Prelude.Bool,
    -- | The environment variables to set in the Docker container.
    CreateTrainingJob -> Maybe (HashMap Text Text)
environment :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    CreateTrainingJob -> Maybe ExperimentConfig
experimentConfig :: Prelude.Maybe ExperimentConfig,
    -- | Algorithm-specific parameters that influence the quality of the model.
    -- You set hyperparameters before you start the learning process. For a
    -- list of hyperparameters for each training algorithm provided by
    -- SageMaker, see
    -- <https://docs.aws.amazon.com/sagemaker/latest/dg/algos.html Algorithms>.
    --
    -- You can specify a maximum of 100 hyperparameters. Each hyperparameter is
    -- a key-value pair. Each key and value is limited to 256 characters, as
    -- specified by the @Length Constraint@.
    --
    -- Do not include any security-sensitive information including account
    -- access IDs, secrets or tokens in any hyperparameter field. If the use of
    -- security-sensitive credentials are detected, SageMaker will reject your
    -- training job request and return an exception error.
    CreateTrainingJob -> Maybe (HashMap Text Text)
hyperParameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | An array of @Channel@ objects. Each channel is a named input source.
    -- @InputDataConfig@ describes the input data and its location.
    --
    -- Algorithms can accept input data from one or more channels. For example,
    -- an algorithm might have two channels of input data, @training_data@ and
    -- @validation_data@. The configuration for each channel provides the S3,
    -- EFS, or FSx location where the input data is stored. It also provides
    -- information about the stored data: the MIME type, compression method,
    -- and whether the data is wrapped in RecordIO format.
    --
    -- Depending on the input mode that the algorithm supports, SageMaker
    -- either copies input data files from an S3 bucket to a local directory in
    -- the Docker container, or makes it available as input streams. For
    -- example, if you specify an EFS location, input data files are available
    -- as input streams. They do not need to be downloaded.
    CreateTrainingJob -> Maybe (NonEmpty Channel)
inputDataConfig :: Prelude.Maybe (Prelude.NonEmpty Channel),
    CreateTrainingJob -> Maybe ProfilerConfig
profilerConfig :: Prelude.Maybe ProfilerConfig,
    -- | Configuration information for Amazon SageMaker Debugger rules for
    -- profiling system and framework metrics.
    CreateTrainingJob -> Maybe [ProfilerRuleConfiguration]
profilerRuleConfigurations :: Prelude.Maybe [ProfilerRuleConfiguration],
    -- | The number of times to retry the job when the job fails due to an
    -- @InternalServerError@.
    CreateTrainingJob -> Maybe RetryStrategy
retryStrategy :: Prelude.Maybe RetryStrategy,
    -- | An array of key-value pairs. You can use tags to categorize your Amazon
    -- Web Services resources in different ways, for example, by purpose,
    -- owner, or environment. For more information, see
    -- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services Resources>.
    CreateTrainingJob -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    CreateTrainingJob -> Maybe TensorBoardOutputConfig
tensorBoardOutputConfig :: Prelude.Maybe TensorBoardOutputConfig,
    -- | A VpcConfig object that specifies the VPC that you want your training
    -- job to connect to. Control access to and from your training container by
    -- configuring the VPC. For more information, see
    -- <https://docs.aws.amazon.com/sagemaker/latest/dg/train-vpc.html Protect Training Jobs by Using an Amazon Virtual Private Cloud>.
    CreateTrainingJob -> Maybe VpcConfig
vpcConfig :: Prelude.Maybe VpcConfig,
    -- | The name of the training job. The name must be unique within an Amazon
    -- Web Services Region in an Amazon Web Services account.
    CreateTrainingJob -> Text
trainingJobName :: Prelude.Text,
    -- | The registry path of the Docker image that contains the training
    -- algorithm and algorithm-specific metadata, including the input mode. For
    -- more information about algorithms provided by SageMaker, see
    -- <https://docs.aws.amazon.com/sagemaker/latest/dg/algos.html Algorithms>.
    -- For information about providing your own algorithms, see
    -- <https://docs.aws.amazon.com/sagemaker/latest/dg/your-algorithms.html Using Your Own Algorithms with Amazon SageMaker>.
    CreateTrainingJob -> AlgorithmSpecification
algorithmSpecification :: AlgorithmSpecification,
    -- | The Amazon Resource Name (ARN) of an IAM role that SageMaker can assume
    -- to perform tasks on your behalf.
    --
    -- During model training, SageMaker needs your permission to read input
    -- data from an S3 bucket, download a Docker image that contains training
    -- code, write model artifacts to an S3 bucket, write logs to Amazon
    -- CloudWatch Logs, and publish metrics to Amazon CloudWatch. You grant
    -- permissions for all of these tasks to an IAM role. For more information,
    -- see
    -- <https://docs.aws.amazon.com/sagemaker/latest/dg/sagemaker-roles.html SageMaker Roles>.
    --
    -- To be able to pass this role to SageMaker, the caller of this API must
    -- have the @iam:PassRole@ permission.
    CreateTrainingJob -> Text
roleArn :: Prelude.Text,
    -- | Specifies the path to the S3 location where you want to store model
    -- artifacts. SageMaker creates subfolders for the artifacts.
    CreateTrainingJob -> OutputDataConfig
outputDataConfig :: OutputDataConfig,
    -- | The resources, including the ML compute instances and ML storage
    -- volumes, to use for model training.
    --
    -- ML storage volumes store model artifacts and incremental states.
    -- Training algorithms might also use ML storage volumes for scratch space.
    -- If you want SageMaker to use the ML storage volume to store the training
    -- data, choose @File@ as the @TrainingInputMode@ in the algorithm
    -- specification. For distributed training algorithms, specify an instance
    -- count greater than 1.
    CreateTrainingJob -> ResourceConfig
resourceConfig :: ResourceConfig,
    -- | Specifies a limit to how long a model training job can run. It also
    -- specifies how long a managed Spot training job has to complete. When the
    -- job reaches the time limit, SageMaker ends the training job. Use this
    -- API to cap model training costs.
    --
    -- To stop a job, SageMaker sends the algorithm the @SIGTERM@ signal, which
    -- delays job termination for 120 seconds. Algorithms can use this
    -- 120-second window to save the model artifacts, so the results of
    -- training are not lost.
    CreateTrainingJob -> StoppingCondition
stoppingCondition :: StoppingCondition
  }
  deriving (CreateTrainingJob -> CreateTrainingJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateTrainingJob -> CreateTrainingJob -> Bool
$c/= :: CreateTrainingJob -> CreateTrainingJob -> Bool
== :: CreateTrainingJob -> CreateTrainingJob -> Bool
$c== :: CreateTrainingJob -> CreateTrainingJob -> Bool
Prelude.Eq, ReadPrec [CreateTrainingJob]
ReadPrec CreateTrainingJob
Int -> ReadS CreateTrainingJob
ReadS [CreateTrainingJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateTrainingJob]
$creadListPrec :: ReadPrec [CreateTrainingJob]
readPrec :: ReadPrec CreateTrainingJob
$creadPrec :: ReadPrec CreateTrainingJob
readList :: ReadS [CreateTrainingJob]
$creadList :: ReadS [CreateTrainingJob]
readsPrec :: Int -> ReadS CreateTrainingJob
$creadsPrec :: Int -> ReadS CreateTrainingJob
Prelude.Read, Int -> CreateTrainingJob -> ShowS
[CreateTrainingJob] -> ShowS
CreateTrainingJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateTrainingJob] -> ShowS
$cshowList :: [CreateTrainingJob] -> ShowS
show :: CreateTrainingJob -> String
$cshow :: CreateTrainingJob -> String
showsPrec :: Int -> CreateTrainingJob -> ShowS
$cshowsPrec :: Int -> CreateTrainingJob -> ShowS
Prelude.Show, forall x. Rep CreateTrainingJob x -> CreateTrainingJob
forall x. CreateTrainingJob -> Rep CreateTrainingJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateTrainingJob x -> CreateTrainingJob
$cfrom :: forall x. CreateTrainingJob -> Rep CreateTrainingJob x
Prelude.Generic)

-- |
-- Create a value of 'CreateTrainingJob' 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:
--
-- 'checkpointConfig', 'createTrainingJob_checkpointConfig' - Contains information about the output location for managed spot training
-- checkpoint data.
--
-- 'debugHookConfig', 'createTrainingJob_debugHookConfig' - Undocumented member.
--
-- 'debugRuleConfigurations', 'createTrainingJob_debugRuleConfigurations' - Configuration information for Amazon SageMaker Debugger rules for
-- debugging output tensors.
--
-- 'enableInterContainerTrafficEncryption', 'createTrainingJob_enableInterContainerTrafficEncryption' - To encrypt all communications between ML compute instances in
-- distributed training, choose @True@. Encryption provides greater
-- security for distributed training, but training might take longer. How
-- long it takes depends on the amount of communication between compute
-- instances, especially if you use a deep learning algorithm in
-- distributed training. For more information, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/train-encrypt.html Protect Communications Between ML Compute Instances in a Distributed Training Job>.
--
-- 'enableManagedSpotTraining', 'createTrainingJob_enableManagedSpotTraining' - To train models using managed spot training, choose @True@. Managed spot
-- training provides a fully managed and scalable infrastructure for
-- training machine learning models. this option is useful when training
-- jobs can be interrupted and when there is flexibility when the training
-- job is run.
--
-- The complete and intermediate results of jobs are stored in an Amazon S3
-- bucket, and can be used as a starting point to train models
-- incrementally. Amazon SageMaker provides metrics and logs in CloudWatch.
-- They can be used to see when managed spot training jobs are running,
-- interrupted, resumed, or completed.
--
-- 'enableNetworkIsolation', 'createTrainingJob_enableNetworkIsolation' - Isolates the training container. No inbound or outbound network calls
-- can be made, except for calls between peers within a training cluster
-- for distributed training. If you enable network isolation for training
-- jobs that are configured to use a VPC, SageMaker downloads and uploads
-- customer data and model artifacts through the specified VPC, but the
-- training container does not have network access.
--
-- 'environment', 'createTrainingJob_environment' - The environment variables to set in the Docker container.
--
-- 'experimentConfig', 'createTrainingJob_experimentConfig' - Undocumented member.
--
-- 'hyperParameters', 'createTrainingJob_hyperParameters' - Algorithm-specific parameters that influence the quality of the model.
-- You set hyperparameters before you start the learning process. For a
-- list of hyperparameters for each training algorithm provided by
-- SageMaker, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/algos.html Algorithms>.
--
-- You can specify a maximum of 100 hyperparameters. Each hyperparameter is
-- a key-value pair. Each key and value is limited to 256 characters, as
-- specified by the @Length Constraint@.
--
-- Do not include any security-sensitive information including account
-- access IDs, secrets or tokens in any hyperparameter field. If the use of
-- security-sensitive credentials are detected, SageMaker will reject your
-- training job request and return an exception error.
--
-- 'inputDataConfig', 'createTrainingJob_inputDataConfig' - An array of @Channel@ objects. Each channel is a named input source.
-- @InputDataConfig@ describes the input data and its location.
--
-- Algorithms can accept input data from one or more channels. For example,
-- an algorithm might have two channels of input data, @training_data@ and
-- @validation_data@. The configuration for each channel provides the S3,
-- EFS, or FSx location where the input data is stored. It also provides
-- information about the stored data: the MIME type, compression method,
-- and whether the data is wrapped in RecordIO format.
--
-- Depending on the input mode that the algorithm supports, SageMaker
-- either copies input data files from an S3 bucket to a local directory in
-- the Docker container, or makes it available as input streams. For
-- example, if you specify an EFS location, input data files are available
-- as input streams. They do not need to be downloaded.
--
-- 'profilerConfig', 'createTrainingJob_profilerConfig' - Undocumented member.
--
-- 'profilerRuleConfigurations', 'createTrainingJob_profilerRuleConfigurations' - Configuration information for Amazon SageMaker Debugger rules for
-- profiling system and framework metrics.
--
-- 'retryStrategy', 'createTrainingJob_retryStrategy' - The number of times to retry the job when the job fails due to an
-- @InternalServerError@.
--
-- 'tags', 'createTrainingJob_tags' - An array of key-value pairs. You can use tags to categorize your Amazon
-- Web Services resources in different ways, for example, by purpose,
-- owner, or environment. For more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services Resources>.
--
-- 'tensorBoardOutputConfig', 'createTrainingJob_tensorBoardOutputConfig' - Undocumented member.
--
-- 'vpcConfig', 'createTrainingJob_vpcConfig' - A VpcConfig object that specifies the VPC that you want your training
-- job to connect to. Control access to and from your training container by
-- configuring the VPC. For more information, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/train-vpc.html Protect Training Jobs by Using an Amazon Virtual Private Cloud>.
--
-- 'trainingJobName', 'createTrainingJob_trainingJobName' - The name of the training job. The name must be unique within an Amazon
-- Web Services Region in an Amazon Web Services account.
--
-- 'algorithmSpecification', 'createTrainingJob_algorithmSpecification' - The registry path of the Docker image that contains the training
-- algorithm and algorithm-specific metadata, including the input mode. For
-- more information about algorithms provided by SageMaker, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/algos.html Algorithms>.
-- For information about providing your own algorithms, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/your-algorithms.html Using Your Own Algorithms with Amazon SageMaker>.
--
-- 'roleArn', 'createTrainingJob_roleArn' - The Amazon Resource Name (ARN) of an IAM role that SageMaker can assume
-- to perform tasks on your behalf.
--
-- During model training, SageMaker needs your permission to read input
-- data from an S3 bucket, download a Docker image that contains training
-- code, write model artifacts to an S3 bucket, write logs to Amazon
-- CloudWatch Logs, and publish metrics to Amazon CloudWatch. You grant
-- permissions for all of these tasks to an IAM role. For more information,
-- see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/sagemaker-roles.html SageMaker Roles>.
--
-- To be able to pass this role to SageMaker, the caller of this API must
-- have the @iam:PassRole@ permission.
--
-- 'outputDataConfig', 'createTrainingJob_outputDataConfig' - Specifies the path to the S3 location where you want to store model
-- artifacts. SageMaker creates subfolders for the artifacts.
--
-- 'resourceConfig', 'createTrainingJob_resourceConfig' - The resources, including the ML compute instances and ML storage
-- volumes, to use for model training.
--
-- ML storage volumes store model artifacts and incremental states.
-- Training algorithms might also use ML storage volumes for scratch space.
-- If you want SageMaker to use the ML storage volume to store the training
-- data, choose @File@ as the @TrainingInputMode@ in the algorithm
-- specification. For distributed training algorithms, specify an instance
-- count greater than 1.
--
-- 'stoppingCondition', 'createTrainingJob_stoppingCondition' - Specifies a limit to how long a model training job can run. It also
-- specifies how long a managed Spot training job has to complete. When the
-- job reaches the time limit, SageMaker ends the training job. Use this
-- API to cap model training costs.
--
-- To stop a job, SageMaker sends the algorithm the @SIGTERM@ signal, which
-- delays job termination for 120 seconds. Algorithms can use this
-- 120-second window to save the model artifacts, so the results of
-- training are not lost.
newCreateTrainingJob ::
  -- | 'trainingJobName'
  Prelude.Text ->
  -- | 'algorithmSpecification'
  AlgorithmSpecification ->
  -- | 'roleArn'
  Prelude.Text ->
  -- | 'outputDataConfig'
  OutputDataConfig ->
  -- | 'resourceConfig'
  ResourceConfig ->
  -- | 'stoppingCondition'
  StoppingCondition ->
  CreateTrainingJob
newCreateTrainingJob :: Text
-> AlgorithmSpecification
-> Text
-> OutputDataConfig
-> ResourceConfig
-> StoppingCondition
-> CreateTrainingJob
newCreateTrainingJob
  Text
pTrainingJobName_
  AlgorithmSpecification
pAlgorithmSpecification_
  Text
pRoleArn_
  OutputDataConfig
pOutputDataConfig_
  ResourceConfig
pResourceConfig_
  StoppingCondition
pStoppingCondition_ =
    CreateTrainingJob'
      { $sel:checkpointConfig:CreateTrainingJob' :: Maybe CheckpointConfig
checkpointConfig =
          forall a. Maybe a
Prelude.Nothing,
        $sel:debugHookConfig:CreateTrainingJob' :: Maybe DebugHookConfig
debugHookConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:debugRuleConfigurations:CreateTrainingJob' :: Maybe [DebugRuleConfiguration]
debugRuleConfigurations = forall a. Maybe a
Prelude.Nothing,
        $sel:enableInterContainerTrafficEncryption:CreateTrainingJob' :: Maybe Bool
enableInterContainerTrafficEncryption =
          forall a. Maybe a
Prelude.Nothing,
        $sel:enableManagedSpotTraining:CreateTrainingJob' :: Maybe Bool
enableManagedSpotTraining = forall a. Maybe a
Prelude.Nothing,
        $sel:enableNetworkIsolation:CreateTrainingJob' :: Maybe Bool
enableNetworkIsolation = forall a. Maybe a
Prelude.Nothing,
        $sel:environment:CreateTrainingJob' :: Maybe (HashMap Text Text)
environment = forall a. Maybe a
Prelude.Nothing,
        $sel:experimentConfig:CreateTrainingJob' :: Maybe ExperimentConfig
experimentConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:hyperParameters:CreateTrainingJob' :: Maybe (HashMap Text Text)
hyperParameters = forall a. Maybe a
Prelude.Nothing,
        $sel:inputDataConfig:CreateTrainingJob' :: Maybe (NonEmpty Channel)
inputDataConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:profilerConfig:CreateTrainingJob' :: Maybe ProfilerConfig
profilerConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:profilerRuleConfigurations:CreateTrainingJob' :: Maybe [ProfilerRuleConfiguration]
profilerRuleConfigurations = forall a. Maybe a
Prelude.Nothing,
        $sel:retryStrategy:CreateTrainingJob' :: Maybe RetryStrategy
retryStrategy = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateTrainingJob' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:tensorBoardOutputConfig:CreateTrainingJob' :: Maybe TensorBoardOutputConfig
tensorBoardOutputConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:vpcConfig:CreateTrainingJob' :: Maybe VpcConfig
vpcConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:trainingJobName:CreateTrainingJob' :: Text
trainingJobName = Text
pTrainingJobName_,
        $sel:algorithmSpecification:CreateTrainingJob' :: AlgorithmSpecification
algorithmSpecification = AlgorithmSpecification
pAlgorithmSpecification_,
        $sel:roleArn:CreateTrainingJob' :: Text
roleArn = Text
pRoleArn_,
        $sel:outputDataConfig:CreateTrainingJob' :: OutputDataConfig
outputDataConfig = OutputDataConfig
pOutputDataConfig_,
        $sel:resourceConfig:CreateTrainingJob' :: ResourceConfig
resourceConfig = ResourceConfig
pResourceConfig_,
        $sel:stoppingCondition:CreateTrainingJob' :: StoppingCondition
stoppingCondition = StoppingCondition
pStoppingCondition_
      }

-- | Contains information about the output location for managed spot training
-- checkpoint data.
createTrainingJob_checkpointConfig :: Lens.Lens' CreateTrainingJob (Prelude.Maybe CheckpointConfig)
createTrainingJob_checkpointConfig :: Lens' CreateTrainingJob (Maybe CheckpointConfig)
createTrainingJob_checkpointConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTrainingJob' {Maybe CheckpointConfig
checkpointConfig :: Maybe CheckpointConfig
$sel:checkpointConfig:CreateTrainingJob' :: CreateTrainingJob -> Maybe CheckpointConfig
checkpointConfig} -> Maybe CheckpointConfig
checkpointConfig) (\s :: CreateTrainingJob
s@CreateTrainingJob' {} Maybe CheckpointConfig
a -> CreateTrainingJob
s {$sel:checkpointConfig:CreateTrainingJob' :: Maybe CheckpointConfig
checkpointConfig = Maybe CheckpointConfig
a} :: CreateTrainingJob)

-- | Undocumented member.
createTrainingJob_debugHookConfig :: Lens.Lens' CreateTrainingJob (Prelude.Maybe DebugHookConfig)
createTrainingJob_debugHookConfig :: Lens' CreateTrainingJob (Maybe DebugHookConfig)
createTrainingJob_debugHookConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTrainingJob' {Maybe DebugHookConfig
debugHookConfig :: Maybe DebugHookConfig
$sel:debugHookConfig:CreateTrainingJob' :: CreateTrainingJob -> Maybe DebugHookConfig
debugHookConfig} -> Maybe DebugHookConfig
debugHookConfig) (\s :: CreateTrainingJob
s@CreateTrainingJob' {} Maybe DebugHookConfig
a -> CreateTrainingJob
s {$sel:debugHookConfig:CreateTrainingJob' :: Maybe DebugHookConfig
debugHookConfig = Maybe DebugHookConfig
a} :: CreateTrainingJob)

-- | Configuration information for Amazon SageMaker Debugger rules for
-- debugging output tensors.
createTrainingJob_debugRuleConfigurations :: Lens.Lens' CreateTrainingJob (Prelude.Maybe [DebugRuleConfiguration])
createTrainingJob_debugRuleConfigurations :: Lens' CreateTrainingJob (Maybe [DebugRuleConfiguration])
createTrainingJob_debugRuleConfigurations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTrainingJob' {Maybe [DebugRuleConfiguration]
debugRuleConfigurations :: Maybe [DebugRuleConfiguration]
$sel:debugRuleConfigurations:CreateTrainingJob' :: CreateTrainingJob -> Maybe [DebugRuleConfiguration]
debugRuleConfigurations} -> Maybe [DebugRuleConfiguration]
debugRuleConfigurations) (\s :: CreateTrainingJob
s@CreateTrainingJob' {} Maybe [DebugRuleConfiguration]
a -> CreateTrainingJob
s {$sel:debugRuleConfigurations:CreateTrainingJob' :: Maybe [DebugRuleConfiguration]
debugRuleConfigurations = Maybe [DebugRuleConfiguration]
a} :: CreateTrainingJob) 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

-- | To encrypt all communications between ML compute instances in
-- distributed training, choose @True@. Encryption provides greater
-- security for distributed training, but training might take longer. How
-- long it takes depends on the amount of communication between compute
-- instances, especially if you use a deep learning algorithm in
-- distributed training. For more information, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/train-encrypt.html Protect Communications Between ML Compute Instances in a Distributed Training Job>.
createTrainingJob_enableInterContainerTrafficEncryption :: Lens.Lens' CreateTrainingJob (Prelude.Maybe Prelude.Bool)
createTrainingJob_enableInterContainerTrafficEncryption :: Lens' CreateTrainingJob (Maybe Bool)
createTrainingJob_enableInterContainerTrafficEncryption = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTrainingJob' {Maybe Bool
enableInterContainerTrafficEncryption :: Maybe Bool
$sel:enableInterContainerTrafficEncryption:CreateTrainingJob' :: CreateTrainingJob -> Maybe Bool
enableInterContainerTrafficEncryption} -> Maybe Bool
enableInterContainerTrafficEncryption) (\s :: CreateTrainingJob
s@CreateTrainingJob' {} Maybe Bool
a -> CreateTrainingJob
s {$sel:enableInterContainerTrafficEncryption:CreateTrainingJob' :: Maybe Bool
enableInterContainerTrafficEncryption = Maybe Bool
a} :: CreateTrainingJob)

-- | To train models using managed spot training, choose @True@. Managed spot
-- training provides a fully managed and scalable infrastructure for
-- training machine learning models. this option is useful when training
-- jobs can be interrupted and when there is flexibility when the training
-- job is run.
--
-- The complete and intermediate results of jobs are stored in an Amazon S3
-- bucket, and can be used as a starting point to train models
-- incrementally. Amazon SageMaker provides metrics and logs in CloudWatch.
-- They can be used to see when managed spot training jobs are running,
-- interrupted, resumed, or completed.
createTrainingJob_enableManagedSpotTraining :: Lens.Lens' CreateTrainingJob (Prelude.Maybe Prelude.Bool)
createTrainingJob_enableManagedSpotTraining :: Lens' CreateTrainingJob (Maybe Bool)
createTrainingJob_enableManagedSpotTraining = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTrainingJob' {Maybe Bool
enableManagedSpotTraining :: Maybe Bool
$sel:enableManagedSpotTraining:CreateTrainingJob' :: CreateTrainingJob -> Maybe Bool
enableManagedSpotTraining} -> Maybe Bool
enableManagedSpotTraining) (\s :: CreateTrainingJob
s@CreateTrainingJob' {} Maybe Bool
a -> CreateTrainingJob
s {$sel:enableManagedSpotTraining:CreateTrainingJob' :: Maybe Bool
enableManagedSpotTraining = Maybe Bool
a} :: CreateTrainingJob)

-- | Isolates the training container. No inbound or outbound network calls
-- can be made, except for calls between peers within a training cluster
-- for distributed training. If you enable network isolation for training
-- jobs that are configured to use a VPC, SageMaker downloads and uploads
-- customer data and model artifacts through the specified VPC, but the
-- training container does not have network access.
createTrainingJob_enableNetworkIsolation :: Lens.Lens' CreateTrainingJob (Prelude.Maybe Prelude.Bool)
createTrainingJob_enableNetworkIsolation :: Lens' CreateTrainingJob (Maybe Bool)
createTrainingJob_enableNetworkIsolation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTrainingJob' {Maybe Bool
enableNetworkIsolation :: Maybe Bool
$sel:enableNetworkIsolation:CreateTrainingJob' :: CreateTrainingJob -> Maybe Bool
enableNetworkIsolation} -> Maybe Bool
enableNetworkIsolation) (\s :: CreateTrainingJob
s@CreateTrainingJob' {} Maybe Bool
a -> CreateTrainingJob
s {$sel:enableNetworkIsolation:CreateTrainingJob' :: Maybe Bool
enableNetworkIsolation = Maybe Bool
a} :: CreateTrainingJob)

-- | The environment variables to set in the Docker container.
createTrainingJob_environment :: Lens.Lens' CreateTrainingJob (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createTrainingJob_environment :: Lens' CreateTrainingJob (Maybe (HashMap Text Text))
createTrainingJob_environment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTrainingJob' {Maybe (HashMap Text Text)
environment :: Maybe (HashMap Text Text)
$sel:environment:CreateTrainingJob' :: CreateTrainingJob -> Maybe (HashMap Text Text)
environment} -> Maybe (HashMap Text Text)
environment) (\s :: CreateTrainingJob
s@CreateTrainingJob' {} Maybe (HashMap Text Text)
a -> CreateTrainingJob
s {$sel:environment:CreateTrainingJob' :: Maybe (HashMap Text Text)
environment = Maybe (HashMap Text Text)
a} :: CreateTrainingJob) 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.
createTrainingJob_experimentConfig :: Lens.Lens' CreateTrainingJob (Prelude.Maybe ExperimentConfig)
createTrainingJob_experimentConfig :: Lens' CreateTrainingJob (Maybe ExperimentConfig)
createTrainingJob_experimentConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTrainingJob' {Maybe ExperimentConfig
experimentConfig :: Maybe ExperimentConfig
$sel:experimentConfig:CreateTrainingJob' :: CreateTrainingJob -> Maybe ExperimentConfig
experimentConfig} -> Maybe ExperimentConfig
experimentConfig) (\s :: CreateTrainingJob
s@CreateTrainingJob' {} Maybe ExperimentConfig
a -> CreateTrainingJob
s {$sel:experimentConfig:CreateTrainingJob' :: Maybe ExperimentConfig
experimentConfig = Maybe ExperimentConfig
a} :: CreateTrainingJob)

-- | Algorithm-specific parameters that influence the quality of the model.
-- You set hyperparameters before you start the learning process. For a
-- list of hyperparameters for each training algorithm provided by
-- SageMaker, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/algos.html Algorithms>.
--
-- You can specify a maximum of 100 hyperparameters. Each hyperparameter is
-- a key-value pair. Each key and value is limited to 256 characters, as
-- specified by the @Length Constraint@.
--
-- Do not include any security-sensitive information including account
-- access IDs, secrets or tokens in any hyperparameter field. If the use of
-- security-sensitive credentials are detected, SageMaker will reject your
-- training job request and return an exception error.
createTrainingJob_hyperParameters :: Lens.Lens' CreateTrainingJob (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createTrainingJob_hyperParameters :: Lens' CreateTrainingJob (Maybe (HashMap Text Text))
createTrainingJob_hyperParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTrainingJob' {Maybe (HashMap Text Text)
hyperParameters :: Maybe (HashMap Text Text)
$sel:hyperParameters:CreateTrainingJob' :: CreateTrainingJob -> Maybe (HashMap Text Text)
hyperParameters} -> Maybe (HashMap Text Text)
hyperParameters) (\s :: CreateTrainingJob
s@CreateTrainingJob' {} Maybe (HashMap Text Text)
a -> CreateTrainingJob
s {$sel:hyperParameters:CreateTrainingJob' :: Maybe (HashMap Text Text)
hyperParameters = Maybe (HashMap Text Text)
a} :: CreateTrainingJob) 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

-- | An array of @Channel@ objects. Each channel is a named input source.
-- @InputDataConfig@ describes the input data and its location.
--
-- Algorithms can accept input data from one or more channels. For example,
-- an algorithm might have two channels of input data, @training_data@ and
-- @validation_data@. The configuration for each channel provides the S3,
-- EFS, or FSx location where the input data is stored. It also provides
-- information about the stored data: the MIME type, compression method,
-- and whether the data is wrapped in RecordIO format.
--
-- Depending on the input mode that the algorithm supports, SageMaker
-- either copies input data files from an S3 bucket to a local directory in
-- the Docker container, or makes it available as input streams. For
-- example, if you specify an EFS location, input data files are available
-- as input streams. They do not need to be downloaded.
createTrainingJob_inputDataConfig :: Lens.Lens' CreateTrainingJob (Prelude.Maybe (Prelude.NonEmpty Channel))
createTrainingJob_inputDataConfig :: Lens' CreateTrainingJob (Maybe (NonEmpty Channel))
createTrainingJob_inputDataConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTrainingJob' {Maybe (NonEmpty Channel)
inputDataConfig :: Maybe (NonEmpty Channel)
$sel:inputDataConfig:CreateTrainingJob' :: CreateTrainingJob -> Maybe (NonEmpty Channel)
inputDataConfig} -> Maybe (NonEmpty Channel)
inputDataConfig) (\s :: CreateTrainingJob
s@CreateTrainingJob' {} Maybe (NonEmpty Channel)
a -> CreateTrainingJob
s {$sel:inputDataConfig:CreateTrainingJob' :: Maybe (NonEmpty Channel)
inputDataConfig = Maybe (NonEmpty Channel)
a} :: CreateTrainingJob) 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.
createTrainingJob_profilerConfig :: Lens.Lens' CreateTrainingJob (Prelude.Maybe ProfilerConfig)
createTrainingJob_profilerConfig :: Lens' CreateTrainingJob (Maybe ProfilerConfig)
createTrainingJob_profilerConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTrainingJob' {Maybe ProfilerConfig
profilerConfig :: Maybe ProfilerConfig
$sel:profilerConfig:CreateTrainingJob' :: CreateTrainingJob -> Maybe ProfilerConfig
profilerConfig} -> Maybe ProfilerConfig
profilerConfig) (\s :: CreateTrainingJob
s@CreateTrainingJob' {} Maybe ProfilerConfig
a -> CreateTrainingJob
s {$sel:profilerConfig:CreateTrainingJob' :: Maybe ProfilerConfig
profilerConfig = Maybe ProfilerConfig
a} :: CreateTrainingJob)

-- | Configuration information for Amazon SageMaker Debugger rules for
-- profiling system and framework metrics.
createTrainingJob_profilerRuleConfigurations :: Lens.Lens' CreateTrainingJob (Prelude.Maybe [ProfilerRuleConfiguration])
createTrainingJob_profilerRuleConfigurations :: Lens' CreateTrainingJob (Maybe [ProfilerRuleConfiguration])
createTrainingJob_profilerRuleConfigurations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTrainingJob' {Maybe [ProfilerRuleConfiguration]
profilerRuleConfigurations :: Maybe [ProfilerRuleConfiguration]
$sel:profilerRuleConfigurations:CreateTrainingJob' :: CreateTrainingJob -> Maybe [ProfilerRuleConfiguration]
profilerRuleConfigurations} -> Maybe [ProfilerRuleConfiguration]
profilerRuleConfigurations) (\s :: CreateTrainingJob
s@CreateTrainingJob' {} Maybe [ProfilerRuleConfiguration]
a -> CreateTrainingJob
s {$sel:profilerRuleConfigurations:CreateTrainingJob' :: Maybe [ProfilerRuleConfiguration]
profilerRuleConfigurations = Maybe [ProfilerRuleConfiguration]
a} :: CreateTrainingJob) 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 number of times to retry the job when the job fails due to an
-- @InternalServerError@.
createTrainingJob_retryStrategy :: Lens.Lens' CreateTrainingJob (Prelude.Maybe RetryStrategy)
createTrainingJob_retryStrategy :: Lens' CreateTrainingJob (Maybe RetryStrategy)
createTrainingJob_retryStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTrainingJob' {Maybe RetryStrategy
retryStrategy :: Maybe RetryStrategy
$sel:retryStrategy:CreateTrainingJob' :: CreateTrainingJob -> Maybe RetryStrategy
retryStrategy} -> Maybe RetryStrategy
retryStrategy) (\s :: CreateTrainingJob
s@CreateTrainingJob' {} Maybe RetryStrategy
a -> CreateTrainingJob
s {$sel:retryStrategy:CreateTrainingJob' :: Maybe RetryStrategy
retryStrategy = Maybe RetryStrategy
a} :: CreateTrainingJob)

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

-- | A VpcConfig object that specifies the VPC that you want your training
-- job to connect to. Control access to and from your training container by
-- configuring the VPC. For more information, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/train-vpc.html Protect Training Jobs by Using an Amazon Virtual Private Cloud>.
createTrainingJob_vpcConfig :: Lens.Lens' CreateTrainingJob (Prelude.Maybe VpcConfig)
createTrainingJob_vpcConfig :: Lens' CreateTrainingJob (Maybe VpcConfig)
createTrainingJob_vpcConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTrainingJob' {Maybe VpcConfig
vpcConfig :: Maybe VpcConfig
$sel:vpcConfig:CreateTrainingJob' :: CreateTrainingJob -> Maybe VpcConfig
vpcConfig} -> Maybe VpcConfig
vpcConfig) (\s :: CreateTrainingJob
s@CreateTrainingJob' {} Maybe VpcConfig
a -> CreateTrainingJob
s {$sel:vpcConfig:CreateTrainingJob' :: Maybe VpcConfig
vpcConfig = Maybe VpcConfig
a} :: CreateTrainingJob)

-- | The name of the training job. The name must be unique within an Amazon
-- Web Services Region in an Amazon Web Services account.
createTrainingJob_trainingJobName :: Lens.Lens' CreateTrainingJob Prelude.Text
createTrainingJob_trainingJobName :: Lens' CreateTrainingJob Text
createTrainingJob_trainingJobName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTrainingJob' {Text
trainingJobName :: Text
$sel:trainingJobName:CreateTrainingJob' :: CreateTrainingJob -> Text
trainingJobName} -> Text
trainingJobName) (\s :: CreateTrainingJob
s@CreateTrainingJob' {} Text
a -> CreateTrainingJob
s {$sel:trainingJobName:CreateTrainingJob' :: Text
trainingJobName = Text
a} :: CreateTrainingJob)

-- | The registry path of the Docker image that contains the training
-- algorithm and algorithm-specific metadata, including the input mode. For
-- more information about algorithms provided by SageMaker, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/algos.html Algorithms>.
-- For information about providing your own algorithms, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/your-algorithms.html Using Your Own Algorithms with Amazon SageMaker>.
createTrainingJob_algorithmSpecification :: Lens.Lens' CreateTrainingJob AlgorithmSpecification
createTrainingJob_algorithmSpecification :: Lens' CreateTrainingJob AlgorithmSpecification
createTrainingJob_algorithmSpecification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTrainingJob' {AlgorithmSpecification
algorithmSpecification :: AlgorithmSpecification
$sel:algorithmSpecification:CreateTrainingJob' :: CreateTrainingJob -> AlgorithmSpecification
algorithmSpecification} -> AlgorithmSpecification
algorithmSpecification) (\s :: CreateTrainingJob
s@CreateTrainingJob' {} AlgorithmSpecification
a -> CreateTrainingJob
s {$sel:algorithmSpecification:CreateTrainingJob' :: AlgorithmSpecification
algorithmSpecification = AlgorithmSpecification
a} :: CreateTrainingJob)

-- | The Amazon Resource Name (ARN) of an IAM role that SageMaker can assume
-- to perform tasks on your behalf.
--
-- During model training, SageMaker needs your permission to read input
-- data from an S3 bucket, download a Docker image that contains training
-- code, write model artifacts to an S3 bucket, write logs to Amazon
-- CloudWatch Logs, and publish metrics to Amazon CloudWatch. You grant
-- permissions for all of these tasks to an IAM role. For more information,
-- see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/sagemaker-roles.html SageMaker Roles>.
--
-- To be able to pass this role to SageMaker, the caller of this API must
-- have the @iam:PassRole@ permission.
createTrainingJob_roleArn :: Lens.Lens' CreateTrainingJob Prelude.Text
createTrainingJob_roleArn :: Lens' CreateTrainingJob Text
createTrainingJob_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTrainingJob' {Text
roleArn :: Text
$sel:roleArn:CreateTrainingJob' :: CreateTrainingJob -> Text
roleArn} -> Text
roleArn) (\s :: CreateTrainingJob
s@CreateTrainingJob' {} Text
a -> CreateTrainingJob
s {$sel:roleArn:CreateTrainingJob' :: Text
roleArn = Text
a} :: CreateTrainingJob)

-- | Specifies the path to the S3 location where you want to store model
-- artifacts. SageMaker creates subfolders for the artifacts.
createTrainingJob_outputDataConfig :: Lens.Lens' CreateTrainingJob OutputDataConfig
createTrainingJob_outputDataConfig :: Lens' CreateTrainingJob OutputDataConfig
createTrainingJob_outputDataConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTrainingJob' {OutputDataConfig
outputDataConfig :: OutputDataConfig
$sel:outputDataConfig:CreateTrainingJob' :: CreateTrainingJob -> OutputDataConfig
outputDataConfig} -> OutputDataConfig
outputDataConfig) (\s :: CreateTrainingJob
s@CreateTrainingJob' {} OutputDataConfig
a -> CreateTrainingJob
s {$sel:outputDataConfig:CreateTrainingJob' :: OutputDataConfig
outputDataConfig = OutputDataConfig
a} :: CreateTrainingJob)

-- | The resources, including the ML compute instances and ML storage
-- volumes, to use for model training.
--
-- ML storage volumes store model artifacts and incremental states.
-- Training algorithms might also use ML storage volumes for scratch space.
-- If you want SageMaker to use the ML storage volume to store the training
-- data, choose @File@ as the @TrainingInputMode@ in the algorithm
-- specification. For distributed training algorithms, specify an instance
-- count greater than 1.
createTrainingJob_resourceConfig :: Lens.Lens' CreateTrainingJob ResourceConfig
createTrainingJob_resourceConfig :: Lens' CreateTrainingJob ResourceConfig
createTrainingJob_resourceConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTrainingJob' {ResourceConfig
resourceConfig :: ResourceConfig
$sel:resourceConfig:CreateTrainingJob' :: CreateTrainingJob -> ResourceConfig
resourceConfig} -> ResourceConfig
resourceConfig) (\s :: CreateTrainingJob
s@CreateTrainingJob' {} ResourceConfig
a -> CreateTrainingJob
s {$sel:resourceConfig:CreateTrainingJob' :: ResourceConfig
resourceConfig = ResourceConfig
a} :: CreateTrainingJob)

-- | Specifies a limit to how long a model training job can run. It also
-- specifies how long a managed Spot training job has to complete. When the
-- job reaches the time limit, SageMaker ends the training job. Use this
-- API to cap model training costs.
--
-- To stop a job, SageMaker sends the algorithm the @SIGTERM@ signal, which
-- delays job termination for 120 seconds. Algorithms can use this
-- 120-second window to save the model artifacts, so the results of
-- training are not lost.
createTrainingJob_stoppingCondition :: Lens.Lens' CreateTrainingJob StoppingCondition
createTrainingJob_stoppingCondition :: Lens' CreateTrainingJob StoppingCondition
createTrainingJob_stoppingCondition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTrainingJob' {StoppingCondition
stoppingCondition :: StoppingCondition
$sel:stoppingCondition:CreateTrainingJob' :: CreateTrainingJob -> StoppingCondition
stoppingCondition} -> StoppingCondition
stoppingCondition) (\s :: CreateTrainingJob
s@CreateTrainingJob' {} StoppingCondition
a -> CreateTrainingJob
s {$sel:stoppingCondition:CreateTrainingJob' :: StoppingCondition
stoppingCondition = StoppingCondition
a} :: CreateTrainingJob)

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

instance Prelude.Hashable CreateTrainingJob where
  hashWithSalt :: Int -> CreateTrainingJob -> Int
hashWithSalt Int
_salt CreateTrainingJob' {Maybe Bool
Maybe [DebugRuleConfiguration]
Maybe [ProfilerRuleConfiguration]
Maybe [Tag]
Maybe (NonEmpty Channel)
Maybe (HashMap Text Text)
Maybe CheckpointConfig
Maybe DebugHookConfig
Maybe ExperimentConfig
Maybe ProfilerConfig
Maybe RetryStrategy
Maybe TensorBoardOutputConfig
Maybe VpcConfig
Text
OutputDataConfig
StoppingCondition
AlgorithmSpecification
ResourceConfig
stoppingCondition :: StoppingCondition
resourceConfig :: ResourceConfig
outputDataConfig :: OutputDataConfig
roleArn :: Text
algorithmSpecification :: AlgorithmSpecification
trainingJobName :: Text
vpcConfig :: Maybe VpcConfig
tensorBoardOutputConfig :: Maybe TensorBoardOutputConfig
tags :: Maybe [Tag]
retryStrategy :: Maybe RetryStrategy
profilerRuleConfigurations :: Maybe [ProfilerRuleConfiguration]
profilerConfig :: Maybe ProfilerConfig
inputDataConfig :: Maybe (NonEmpty Channel)
hyperParameters :: Maybe (HashMap Text Text)
experimentConfig :: Maybe ExperimentConfig
environment :: Maybe (HashMap Text Text)
enableNetworkIsolation :: Maybe Bool
enableManagedSpotTraining :: Maybe Bool
enableInterContainerTrafficEncryption :: Maybe Bool
debugRuleConfigurations :: Maybe [DebugRuleConfiguration]
debugHookConfig :: Maybe DebugHookConfig
checkpointConfig :: Maybe CheckpointConfig
$sel:stoppingCondition:CreateTrainingJob' :: CreateTrainingJob -> StoppingCondition
$sel:resourceConfig:CreateTrainingJob' :: CreateTrainingJob -> ResourceConfig
$sel:outputDataConfig:CreateTrainingJob' :: CreateTrainingJob -> OutputDataConfig
$sel:roleArn:CreateTrainingJob' :: CreateTrainingJob -> Text
$sel:algorithmSpecification:CreateTrainingJob' :: CreateTrainingJob -> AlgorithmSpecification
$sel:trainingJobName:CreateTrainingJob' :: CreateTrainingJob -> Text
$sel:vpcConfig:CreateTrainingJob' :: CreateTrainingJob -> Maybe VpcConfig
$sel:tensorBoardOutputConfig:CreateTrainingJob' :: CreateTrainingJob -> Maybe TensorBoardOutputConfig
$sel:tags:CreateTrainingJob' :: CreateTrainingJob -> Maybe [Tag]
$sel:retryStrategy:CreateTrainingJob' :: CreateTrainingJob -> Maybe RetryStrategy
$sel:profilerRuleConfigurations:CreateTrainingJob' :: CreateTrainingJob -> Maybe [ProfilerRuleConfiguration]
$sel:profilerConfig:CreateTrainingJob' :: CreateTrainingJob -> Maybe ProfilerConfig
$sel:inputDataConfig:CreateTrainingJob' :: CreateTrainingJob -> Maybe (NonEmpty Channel)
$sel:hyperParameters:CreateTrainingJob' :: CreateTrainingJob -> Maybe (HashMap Text Text)
$sel:experimentConfig:CreateTrainingJob' :: CreateTrainingJob -> Maybe ExperimentConfig
$sel:environment:CreateTrainingJob' :: CreateTrainingJob -> Maybe (HashMap Text Text)
$sel:enableNetworkIsolation:CreateTrainingJob' :: CreateTrainingJob -> Maybe Bool
$sel:enableManagedSpotTraining:CreateTrainingJob' :: CreateTrainingJob -> Maybe Bool
$sel:enableInterContainerTrafficEncryption:CreateTrainingJob' :: CreateTrainingJob -> Maybe Bool
$sel:debugRuleConfigurations:CreateTrainingJob' :: CreateTrainingJob -> Maybe [DebugRuleConfiguration]
$sel:debugHookConfig:CreateTrainingJob' :: CreateTrainingJob -> Maybe DebugHookConfig
$sel:checkpointConfig:CreateTrainingJob' :: CreateTrainingJob -> Maybe CheckpointConfig
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CheckpointConfig
checkpointConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DebugHookConfig
debugHookConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [DebugRuleConfiguration]
debugRuleConfigurations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enableInterContainerTrafficEncryption
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enableManagedSpotTraining
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
enableNetworkIsolation
      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 (HashMap Text Text)
hyperParameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Channel)
inputDataConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ProfilerConfig
profilerConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ProfilerRuleConfiguration]
profilerRuleConfigurations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RetryStrategy
retryStrategy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TensorBoardOutputConfig
tensorBoardOutputConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VpcConfig
vpcConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
trainingJobName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AlgorithmSpecification
algorithmSpecification
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` OutputDataConfig
outputDataConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ResourceConfig
resourceConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` StoppingCondition
stoppingCondition

instance Prelude.NFData CreateTrainingJob where
  rnf :: CreateTrainingJob -> ()
rnf CreateTrainingJob' {Maybe Bool
Maybe [DebugRuleConfiguration]
Maybe [ProfilerRuleConfiguration]
Maybe [Tag]
Maybe (NonEmpty Channel)
Maybe (HashMap Text Text)
Maybe CheckpointConfig
Maybe DebugHookConfig
Maybe ExperimentConfig
Maybe ProfilerConfig
Maybe RetryStrategy
Maybe TensorBoardOutputConfig
Maybe VpcConfig
Text
OutputDataConfig
StoppingCondition
AlgorithmSpecification
ResourceConfig
stoppingCondition :: StoppingCondition
resourceConfig :: ResourceConfig
outputDataConfig :: OutputDataConfig
roleArn :: Text
algorithmSpecification :: AlgorithmSpecification
trainingJobName :: Text
vpcConfig :: Maybe VpcConfig
tensorBoardOutputConfig :: Maybe TensorBoardOutputConfig
tags :: Maybe [Tag]
retryStrategy :: Maybe RetryStrategy
profilerRuleConfigurations :: Maybe [ProfilerRuleConfiguration]
profilerConfig :: Maybe ProfilerConfig
inputDataConfig :: Maybe (NonEmpty Channel)
hyperParameters :: Maybe (HashMap Text Text)
experimentConfig :: Maybe ExperimentConfig
environment :: Maybe (HashMap Text Text)
enableNetworkIsolation :: Maybe Bool
enableManagedSpotTraining :: Maybe Bool
enableInterContainerTrafficEncryption :: Maybe Bool
debugRuleConfigurations :: Maybe [DebugRuleConfiguration]
debugHookConfig :: Maybe DebugHookConfig
checkpointConfig :: Maybe CheckpointConfig
$sel:stoppingCondition:CreateTrainingJob' :: CreateTrainingJob -> StoppingCondition
$sel:resourceConfig:CreateTrainingJob' :: CreateTrainingJob -> ResourceConfig
$sel:outputDataConfig:CreateTrainingJob' :: CreateTrainingJob -> OutputDataConfig
$sel:roleArn:CreateTrainingJob' :: CreateTrainingJob -> Text
$sel:algorithmSpecification:CreateTrainingJob' :: CreateTrainingJob -> AlgorithmSpecification
$sel:trainingJobName:CreateTrainingJob' :: CreateTrainingJob -> Text
$sel:vpcConfig:CreateTrainingJob' :: CreateTrainingJob -> Maybe VpcConfig
$sel:tensorBoardOutputConfig:CreateTrainingJob' :: CreateTrainingJob -> Maybe TensorBoardOutputConfig
$sel:tags:CreateTrainingJob' :: CreateTrainingJob -> Maybe [Tag]
$sel:retryStrategy:CreateTrainingJob' :: CreateTrainingJob -> Maybe RetryStrategy
$sel:profilerRuleConfigurations:CreateTrainingJob' :: CreateTrainingJob -> Maybe [ProfilerRuleConfiguration]
$sel:profilerConfig:CreateTrainingJob' :: CreateTrainingJob -> Maybe ProfilerConfig
$sel:inputDataConfig:CreateTrainingJob' :: CreateTrainingJob -> Maybe (NonEmpty Channel)
$sel:hyperParameters:CreateTrainingJob' :: CreateTrainingJob -> Maybe (HashMap Text Text)
$sel:experimentConfig:CreateTrainingJob' :: CreateTrainingJob -> Maybe ExperimentConfig
$sel:environment:CreateTrainingJob' :: CreateTrainingJob -> Maybe (HashMap Text Text)
$sel:enableNetworkIsolation:CreateTrainingJob' :: CreateTrainingJob -> Maybe Bool
$sel:enableManagedSpotTraining:CreateTrainingJob' :: CreateTrainingJob -> Maybe Bool
$sel:enableInterContainerTrafficEncryption:CreateTrainingJob' :: CreateTrainingJob -> Maybe Bool
$sel:debugRuleConfigurations:CreateTrainingJob' :: CreateTrainingJob -> Maybe [DebugRuleConfiguration]
$sel:debugHookConfig:CreateTrainingJob' :: CreateTrainingJob -> Maybe DebugHookConfig
$sel:checkpointConfig:CreateTrainingJob' :: CreateTrainingJob -> Maybe CheckpointConfig
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CheckpointConfig
checkpointConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DebugHookConfig
debugHookConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [DebugRuleConfiguration]
debugRuleConfigurations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enableInterContainerTrafficEncryption
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enableManagedSpotTraining
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
enableNetworkIsolation
      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 (HashMap Text Text)
hyperParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Channel)
inputDataConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ProfilerConfig
profilerConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ProfilerRuleConfiguration]
profilerRuleConfigurations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RetryStrategy
retryStrategy
      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 Maybe TensorBoardOutputConfig
tensorBoardOutputConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VpcConfig
vpcConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
trainingJobName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AlgorithmSpecification
algorithmSpecification
      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 OutputDataConfig
outputDataConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ResourceConfig
resourceConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        StoppingCondition
stoppingCondition

instance Data.ToHeaders CreateTrainingJob where
  toHeaders :: CreateTrainingJob -> 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.CreateTrainingJob" ::
                          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 CreateTrainingJob where
  toJSON :: CreateTrainingJob -> Value
toJSON CreateTrainingJob' {Maybe Bool
Maybe [DebugRuleConfiguration]
Maybe [ProfilerRuleConfiguration]
Maybe [Tag]
Maybe (NonEmpty Channel)
Maybe (HashMap Text Text)
Maybe CheckpointConfig
Maybe DebugHookConfig
Maybe ExperimentConfig
Maybe ProfilerConfig
Maybe RetryStrategy
Maybe TensorBoardOutputConfig
Maybe VpcConfig
Text
OutputDataConfig
StoppingCondition
AlgorithmSpecification
ResourceConfig
stoppingCondition :: StoppingCondition
resourceConfig :: ResourceConfig
outputDataConfig :: OutputDataConfig
roleArn :: Text
algorithmSpecification :: AlgorithmSpecification
trainingJobName :: Text
vpcConfig :: Maybe VpcConfig
tensorBoardOutputConfig :: Maybe TensorBoardOutputConfig
tags :: Maybe [Tag]
retryStrategy :: Maybe RetryStrategy
profilerRuleConfigurations :: Maybe [ProfilerRuleConfiguration]
profilerConfig :: Maybe ProfilerConfig
inputDataConfig :: Maybe (NonEmpty Channel)
hyperParameters :: Maybe (HashMap Text Text)
experimentConfig :: Maybe ExperimentConfig
environment :: Maybe (HashMap Text Text)
enableNetworkIsolation :: Maybe Bool
enableManagedSpotTraining :: Maybe Bool
enableInterContainerTrafficEncryption :: Maybe Bool
debugRuleConfigurations :: Maybe [DebugRuleConfiguration]
debugHookConfig :: Maybe DebugHookConfig
checkpointConfig :: Maybe CheckpointConfig
$sel:stoppingCondition:CreateTrainingJob' :: CreateTrainingJob -> StoppingCondition
$sel:resourceConfig:CreateTrainingJob' :: CreateTrainingJob -> ResourceConfig
$sel:outputDataConfig:CreateTrainingJob' :: CreateTrainingJob -> OutputDataConfig
$sel:roleArn:CreateTrainingJob' :: CreateTrainingJob -> Text
$sel:algorithmSpecification:CreateTrainingJob' :: CreateTrainingJob -> AlgorithmSpecification
$sel:trainingJobName:CreateTrainingJob' :: CreateTrainingJob -> Text
$sel:vpcConfig:CreateTrainingJob' :: CreateTrainingJob -> Maybe VpcConfig
$sel:tensorBoardOutputConfig:CreateTrainingJob' :: CreateTrainingJob -> Maybe TensorBoardOutputConfig
$sel:tags:CreateTrainingJob' :: CreateTrainingJob -> Maybe [Tag]
$sel:retryStrategy:CreateTrainingJob' :: CreateTrainingJob -> Maybe RetryStrategy
$sel:profilerRuleConfigurations:CreateTrainingJob' :: CreateTrainingJob -> Maybe [ProfilerRuleConfiguration]
$sel:profilerConfig:CreateTrainingJob' :: CreateTrainingJob -> Maybe ProfilerConfig
$sel:inputDataConfig:CreateTrainingJob' :: CreateTrainingJob -> Maybe (NonEmpty Channel)
$sel:hyperParameters:CreateTrainingJob' :: CreateTrainingJob -> Maybe (HashMap Text Text)
$sel:experimentConfig:CreateTrainingJob' :: CreateTrainingJob -> Maybe ExperimentConfig
$sel:environment:CreateTrainingJob' :: CreateTrainingJob -> Maybe (HashMap Text Text)
$sel:enableNetworkIsolation:CreateTrainingJob' :: CreateTrainingJob -> Maybe Bool
$sel:enableManagedSpotTraining:CreateTrainingJob' :: CreateTrainingJob -> Maybe Bool
$sel:enableInterContainerTrafficEncryption:CreateTrainingJob' :: CreateTrainingJob -> Maybe Bool
$sel:debugRuleConfigurations:CreateTrainingJob' :: CreateTrainingJob -> Maybe [DebugRuleConfiguration]
$sel:debugHookConfig:CreateTrainingJob' :: CreateTrainingJob -> Maybe DebugHookConfig
$sel:checkpointConfig:CreateTrainingJob' :: CreateTrainingJob -> Maybe CheckpointConfig
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CheckpointConfig" 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 CheckpointConfig
checkpointConfig,
            (Key
"DebugHookConfig" 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 DebugHookConfig
debugHookConfig,
            (Key
"DebugRuleConfigurations" 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 [DebugRuleConfiguration]
debugRuleConfigurations,
            (Key
"EnableInterContainerTrafficEncryption" 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 Bool
enableInterContainerTrafficEncryption,
            (Key
"EnableManagedSpotTraining" 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 Bool
enableManagedSpotTraining,
            (Key
"EnableNetworkIsolation" 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 Bool
enableNetworkIsolation,
            (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
"HyperParameters" 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)
hyperParameters,
            (Key
"InputDataConfig" 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 (NonEmpty Channel)
inputDataConfig,
            (Key
"ProfilerConfig" 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 ProfilerConfig
profilerConfig,
            (Key
"ProfilerRuleConfigurations" 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 [ProfilerRuleConfiguration]
profilerRuleConfigurations,
            (Key
"RetryStrategy" 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 RetryStrategy
retryStrategy,
            (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,
            (Key
"TensorBoardOutputConfig" 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 TensorBoardOutputConfig
tensorBoardOutputConfig,
            (Key
"VpcConfig" 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 VpcConfig
vpcConfig,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"TrainingJobName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
trainingJobName),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"AlgorithmSpecification"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= AlgorithmSpecification
algorithmSpecification
              ),
            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
"OutputDataConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= OutputDataConfig
outputDataConfig),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ResourceConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ResourceConfig
resourceConfig),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"StoppingCondition" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= StoppingCondition
stoppingCondition)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateTrainingJobResponse' 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', 'createTrainingJobResponse_httpStatus' - The response's http status code.
--
-- 'trainingJobArn', 'createTrainingJobResponse_trainingJobArn' - The Amazon Resource Name (ARN) of the training job.
newCreateTrainingJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'trainingJobArn'
  Prelude.Text ->
  CreateTrainingJobResponse
newCreateTrainingJobResponse :: Int -> Text -> CreateTrainingJobResponse
newCreateTrainingJobResponse
  Int
pHttpStatus_
  Text
pTrainingJobArn_ =
    CreateTrainingJobResponse'
      { $sel:httpStatus:CreateTrainingJobResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:trainingJobArn:CreateTrainingJobResponse' :: Text
trainingJobArn = Text
pTrainingJobArn_
      }

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

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

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