{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# 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.Types.TrainingJobDefinition
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.SageMaker.Types.TrainingJobDefinition 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 Amazonka.SageMaker.Types.Channel
import Amazonka.SageMaker.Types.OutputDataConfig
import Amazonka.SageMaker.Types.ResourceConfig
import Amazonka.SageMaker.Types.StoppingCondition
import Amazonka.SageMaker.Types.TrainingInputMode

-- | Defines the input needed to run a training job using the algorithm.
--
-- /See:/ 'newTrainingJobDefinition' smart constructor.
data TrainingJobDefinition = TrainingJobDefinition'
  { -- | The hyperparameters used for the training job.
    TrainingJobDefinition -> Maybe (HashMap Text Text)
hyperParameters :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    TrainingJobDefinition -> TrainingInputMode
trainingInputMode :: TrainingInputMode,
    -- | An array of @Channel@ objects, each of which specifies an input source.
    TrainingJobDefinition -> NonEmpty Channel
inputDataConfig :: Prelude.NonEmpty Channel,
    -- | the path to the S3 bucket where you want to store model artifacts.
    -- SageMaker creates subfolders for the artifacts.
    TrainingJobDefinition -> OutputDataConfig
outputDataConfig :: OutputDataConfig,
    -- | The resources, including the ML compute instances and ML storage
    -- volumes, to use for model training.
    TrainingJobDefinition -> 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.
    TrainingJobDefinition -> StoppingCondition
stoppingCondition :: StoppingCondition
  }
  deriving (TrainingJobDefinition -> TrainingJobDefinition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TrainingJobDefinition -> TrainingJobDefinition -> Bool
$c/= :: TrainingJobDefinition -> TrainingJobDefinition -> Bool
== :: TrainingJobDefinition -> TrainingJobDefinition -> Bool
$c== :: TrainingJobDefinition -> TrainingJobDefinition -> Bool
Prelude.Eq, ReadPrec [TrainingJobDefinition]
ReadPrec TrainingJobDefinition
Int -> ReadS TrainingJobDefinition
ReadS [TrainingJobDefinition]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TrainingJobDefinition]
$creadListPrec :: ReadPrec [TrainingJobDefinition]
readPrec :: ReadPrec TrainingJobDefinition
$creadPrec :: ReadPrec TrainingJobDefinition
readList :: ReadS [TrainingJobDefinition]
$creadList :: ReadS [TrainingJobDefinition]
readsPrec :: Int -> ReadS TrainingJobDefinition
$creadsPrec :: Int -> ReadS TrainingJobDefinition
Prelude.Read, Int -> TrainingJobDefinition -> ShowS
[TrainingJobDefinition] -> ShowS
TrainingJobDefinition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TrainingJobDefinition] -> ShowS
$cshowList :: [TrainingJobDefinition] -> ShowS
show :: TrainingJobDefinition -> String
$cshow :: TrainingJobDefinition -> String
showsPrec :: Int -> TrainingJobDefinition -> ShowS
$cshowsPrec :: Int -> TrainingJobDefinition -> ShowS
Prelude.Show, forall x. Rep TrainingJobDefinition x -> TrainingJobDefinition
forall x. TrainingJobDefinition -> Rep TrainingJobDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TrainingJobDefinition x -> TrainingJobDefinition
$cfrom :: forall x. TrainingJobDefinition -> Rep TrainingJobDefinition x
Prelude.Generic)

-- |
-- Create a value of 'TrainingJobDefinition' 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:
--
-- 'hyperParameters', 'trainingJobDefinition_hyperParameters' - The hyperparameters used for the training job.
--
-- 'trainingInputMode', 'trainingJobDefinition_trainingInputMode' - Undocumented member.
--
-- 'inputDataConfig', 'trainingJobDefinition_inputDataConfig' - An array of @Channel@ objects, each of which specifies an input source.
--
-- 'outputDataConfig', 'trainingJobDefinition_outputDataConfig' - the path to the S3 bucket where you want to store model artifacts.
-- SageMaker creates subfolders for the artifacts.
--
-- 'resourceConfig', 'trainingJobDefinition_resourceConfig' - The resources, including the ML compute instances and ML storage
-- volumes, to use for model training.
--
-- 'stoppingCondition', 'trainingJobDefinition_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.
newTrainingJobDefinition ::
  -- | 'trainingInputMode'
  TrainingInputMode ->
  -- | 'inputDataConfig'
  Prelude.NonEmpty Channel ->
  -- | 'outputDataConfig'
  OutputDataConfig ->
  -- | 'resourceConfig'
  ResourceConfig ->
  -- | 'stoppingCondition'
  StoppingCondition ->
  TrainingJobDefinition
newTrainingJobDefinition :: TrainingInputMode
-> NonEmpty Channel
-> OutputDataConfig
-> ResourceConfig
-> StoppingCondition
-> TrainingJobDefinition
newTrainingJobDefinition
  TrainingInputMode
pTrainingInputMode_
  NonEmpty Channel
pInputDataConfig_
  OutputDataConfig
pOutputDataConfig_
  ResourceConfig
pResourceConfig_
  StoppingCondition
pStoppingCondition_ =
    TrainingJobDefinition'
      { $sel:hyperParameters:TrainingJobDefinition' :: Maybe (HashMap Text Text)
hyperParameters =
          forall a. Maybe a
Prelude.Nothing,
        $sel:trainingInputMode:TrainingJobDefinition' :: TrainingInputMode
trainingInputMode = TrainingInputMode
pTrainingInputMode_,
        $sel:inputDataConfig:TrainingJobDefinition' :: NonEmpty Channel
inputDataConfig =
          forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Channel
pInputDataConfig_,
        $sel:outputDataConfig:TrainingJobDefinition' :: OutputDataConfig
outputDataConfig = OutputDataConfig
pOutputDataConfig_,
        $sel:resourceConfig:TrainingJobDefinition' :: ResourceConfig
resourceConfig = ResourceConfig
pResourceConfig_,
        $sel:stoppingCondition:TrainingJobDefinition' :: StoppingCondition
stoppingCondition = StoppingCondition
pStoppingCondition_
      }

-- | The hyperparameters used for the training job.
trainingJobDefinition_hyperParameters :: Lens.Lens' TrainingJobDefinition (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
trainingJobDefinition_hyperParameters :: Lens' TrainingJobDefinition (Maybe (HashMap Text Text))
trainingJobDefinition_hyperParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TrainingJobDefinition' {Maybe (HashMap Text Text)
hyperParameters :: Maybe (HashMap Text Text)
$sel:hyperParameters:TrainingJobDefinition' :: TrainingJobDefinition -> Maybe (HashMap Text Text)
hyperParameters} -> Maybe (HashMap Text Text)
hyperParameters) (\s :: TrainingJobDefinition
s@TrainingJobDefinition' {} Maybe (HashMap Text Text)
a -> TrainingJobDefinition
s {$sel:hyperParameters:TrainingJobDefinition' :: Maybe (HashMap Text Text)
hyperParameters = Maybe (HashMap Text Text)
a} :: TrainingJobDefinition) 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.
trainingJobDefinition_trainingInputMode :: Lens.Lens' TrainingJobDefinition TrainingInputMode
trainingJobDefinition_trainingInputMode :: Lens' TrainingJobDefinition TrainingInputMode
trainingJobDefinition_trainingInputMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TrainingJobDefinition' {TrainingInputMode
trainingInputMode :: TrainingInputMode
$sel:trainingInputMode:TrainingJobDefinition' :: TrainingJobDefinition -> TrainingInputMode
trainingInputMode} -> TrainingInputMode
trainingInputMode) (\s :: TrainingJobDefinition
s@TrainingJobDefinition' {} TrainingInputMode
a -> TrainingJobDefinition
s {$sel:trainingInputMode:TrainingJobDefinition' :: TrainingInputMode
trainingInputMode = TrainingInputMode
a} :: TrainingJobDefinition)

-- | An array of @Channel@ objects, each of which specifies an input source.
trainingJobDefinition_inputDataConfig :: Lens.Lens' TrainingJobDefinition (Prelude.NonEmpty Channel)
trainingJobDefinition_inputDataConfig :: Lens' TrainingJobDefinition (NonEmpty Channel)
trainingJobDefinition_inputDataConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TrainingJobDefinition' {NonEmpty Channel
inputDataConfig :: NonEmpty Channel
$sel:inputDataConfig:TrainingJobDefinition' :: TrainingJobDefinition -> NonEmpty Channel
inputDataConfig} -> NonEmpty Channel
inputDataConfig) (\s :: TrainingJobDefinition
s@TrainingJobDefinition' {} NonEmpty Channel
a -> TrainingJobDefinition
s {$sel:inputDataConfig:TrainingJobDefinition' :: NonEmpty Channel
inputDataConfig = NonEmpty Channel
a} :: TrainingJobDefinition) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

-- | The resources, including the ML compute instances and ML storage
-- volumes, to use for model training.
trainingJobDefinition_resourceConfig :: Lens.Lens' TrainingJobDefinition ResourceConfig
trainingJobDefinition_resourceConfig :: Lens' TrainingJobDefinition ResourceConfig
trainingJobDefinition_resourceConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TrainingJobDefinition' {ResourceConfig
resourceConfig :: ResourceConfig
$sel:resourceConfig:TrainingJobDefinition' :: TrainingJobDefinition -> ResourceConfig
resourceConfig} -> ResourceConfig
resourceConfig) (\s :: TrainingJobDefinition
s@TrainingJobDefinition' {} ResourceConfig
a -> TrainingJobDefinition
s {$sel:resourceConfig:TrainingJobDefinition' :: ResourceConfig
resourceConfig = ResourceConfig
a} :: TrainingJobDefinition)

-- | 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.
trainingJobDefinition_stoppingCondition :: Lens.Lens' TrainingJobDefinition StoppingCondition
trainingJobDefinition_stoppingCondition :: Lens' TrainingJobDefinition StoppingCondition
trainingJobDefinition_stoppingCondition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TrainingJobDefinition' {StoppingCondition
stoppingCondition :: StoppingCondition
$sel:stoppingCondition:TrainingJobDefinition' :: TrainingJobDefinition -> StoppingCondition
stoppingCondition} -> StoppingCondition
stoppingCondition) (\s :: TrainingJobDefinition
s@TrainingJobDefinition' {} StoppingCondition
a -> TrainingJobDefinition
s {$sel:stoppingCondition:TrainingJobDefinition' :: StoppingCondition
stoppingCondition = StoppingCondition
a} :: TrainingJobDefinition)

instance Data.FromJSON TrainingJobDefinition where
  parseJSON :: Value -> Parser TrainingJobDefinition
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"TrainingJobDefinition"
      ( \Object
x ->
          Maybe (HashMap Text Text)
-> TrainingInputMode
-> NonEmpty Channel
-> OutputDataConfig
-> ResourceConfig
-> StoppingCondition
-> TrainingJobDefinition
TrainingJobDefinition'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"HyperParameters"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"TrainingInputMode")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"InputDataConfig")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"OutputDataConfig")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"ResourceConfig")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"StoppingCondition")
      )

instance Prelude.Hashable TrainingJobDefinition where
  hashWithSalt :: Int -> TrainingJobDefinition -> Int
hashWithSalt Int
_salt TrainingJobDefinition' {Maybe (HashMap Text Text)
NonEmpty Channel
OutputDataConfig
StoppingCondition
TrainingInputMode
ResourceConfig
stoppingCondition :: StoppingCondition
resourceConfig :: ResourceConfig
outputDataConfig :: OutputDataConfig
inputDataConfig :: NonEmpty Channel
trainingInputMode :: TrainingInputMode
hyperParameters :: Maybe (HashMap Text Text)
$sel:stoppingCondition:TrainingJobDefinition' :: TrainingJobDefinition -> StoppingCondition
$sel:resourceConfig:TrainingJobDefinition' :: TrainingJobDefinition -> ResourceConfig
$sel:outputDataConfig:TrainingJobDefinition' :: TrainingJobDefinition -> OutputDataConfig
$sel:inputDataConfig:TrainingJobDefinition' :: TrainingJobDefinition -> NonEmpty Channel
$sel:trainingInputMode:TrainingJobDefinition' :: TrainingJobDefinition -> TrainingInputMode
$sel:hyperParameters:TrainingJobDefinition' :: TrainingJobDefinition -> Maybe (HashMap Text Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
hyperParameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` TrainingInputMode
trainingInputMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Channel
inputDataConfig
      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 TrainingJobDefinition where
  rnf :: TrainingJobDefinition -> ()
rnf TrainingJobDefinition' {Maybe (HashMap Text Text)
NonEmpty Channel
OutputDataConfig
StoppingCondition
TrainingInputMode
ResourceConfig
stoppingCondition :: StoppingCondition
resourceConfig :: ResourceConfig
outputDataConfig :: OutputDataConfig
inputDataConfig :: NonEmpty Channel
trainingInputMode :: TrainingInputMode
hyperParameters :: Maybe (HashMap Text Text)
$sel:stoppingCondition:TrainingJobDefinition' :: TrainingJobDefinition -> StoppingCondition
$sel:resourceConfig:TrainingJobDefinition' :: TrainingJobDefinition -> ResourceConfig
$sel:outputDataConfig:TrainingJobDefinition' :: TrainingJobDefinition -> OutputDataConfig
$sel:inputDataConfig:TrainingJobDefinition' :: TrainingJobDefinition -> NonEmpty Channel
$sel:trainingInputMode:TrainingJobDefinition' :: TrainingJobDefinition -> TrainingInputMode
$sel:hyperParameters:TrainingJobDefinition' :: TrainingJobDefinition -> Maybe (HashMap Text Text)
..} =
    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 TrainingInputMode
trainingInputMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Channel
inputDataConfig
      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.ToJSON TrainingJobDefinition where
  toJSON :: TrainingJobDefinition -> Value
toJSON TrainingJobDefinition' {Maybe (HashMap Text Text)
NonEmpty Channel
OutputDataConfig
StoppingCondition
TrainingInputMode
ResourceConfig
stoppingCondition :: StoppingCondition
resourceConfig :: ResourceConfig
outputDataConfig :: OutputDataConfig
inputDataConfig :: NonEmpty Channel
trainingInputMode :: TrainingInputMode
hyperParameters :: Maybe (HashMap Text Text)
$sel:stoppingCondition:TrainingJobDefinition' :: TrainingJobDefinition -> StoppingCondition
$sel:resourceConfig:TrainingJobDefinition' :: TrainingJobDefinition -> ResourceConfig
$sel:outputDataConfig:TrainingJobDefinition' :: TrainingJobDefinition -> OutputDataConfig
$sel:inputDataConfig:TrainingJobDefinition' :: TrainingJobDefinition -> NonEmpty Channel
$sel:trainingInputMode:TrainingJobDefinition' :: TrainingJobDefinition -> TrainingInputMode
$sel:hyperParameters:TrainingJobDefinition' :: TrainingJobDefinition -> Maybe (HashMap Text Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"TrainingInputMode" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= TrainingInputMode
trainingInputMode),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"InputDataConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Channel
inputDataConfig),
            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)
          ]
      )