{-# 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.CreateHyperParameterTuningJob
-- 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 hyperparameter tuning job. A hyperparameter tuning job finds
-- the best version of a model by running many training jobs on your
-- dataset using the algorithm you choose and values for hyperparameters
-- within ranges that you specify. It then chooses the hyperparameter
-- values that result in a model that performs the best, as measured by an
-- objective metric that you choose.
--
-- A hyperparameter tuning job automatically creates Amazon SageMaker
-- experiments, trials, and trial components for each training job that it
-- runs. You can view these entities in Amazon SageMaker Studio. For more
-- information, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/experiments-view-compare.html#experiments-view View Experiments, Trials, and Trial Components>.
--
-- 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.
module Amazonka.SageMaker.CreateHyperParameterTuningJob
  ( -- * Creating a Request
    CreateHyperParameterTuningJob (..),
    newCreateHyperParameterTuningJob,

    -- * Request Lenses
    createHyperParameterTuningJob_tags,
    createHyperParameterTuningJob_trainingJobDefinition,
    createHyperParameterTuningJob_trainingJobDefinitions,
    createHyperParameterTuningJob_warmStartConfig,
    createHyperParameterTuningJob_hyperParameterTuningJobName,
    createHyperParameterTuningJob_hyperParameterTuningJobConfig,

    -- * Destructuring the Response
    CreateHyperParameterTuningJobResponse (..),
    newCreateHyperParameterTuningJobResponse,

    -- * Response Lenses
    createHyperParameterTuningJobResponse_httpStatus,
    createHyperParameterTuningJobResponse_hyperParameterTuningJobArn,
  )
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:/ 'newCreateHyperParameterTuningJob' smart constructor.
data CreateHyperParameterTuningJob = CreateHyperParameterTuningJob'
  { -- | 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>.
    --
    -- Tags that you specify for the tuning job are also added to all training
    -- jobs that the tuning job launches.
    CreateHyperParameterTuningJob -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The HyperParameterTrainingJobDefinition object that describes the
    -- training jobs that this tuning job launches, including static
    -- hyperparameters, input data configuration, output data configuration,
    -- resource configuration, and stopping condition.
    CreateHyperParameterTuningJob
-> Maybe HyperParameterTrainingJobDefinition
trainingJobDefinition :: Prelude.Maybe HyperParameterTrainingJobDefinition,
    -- | A list of the HyperParameterTrainingJobDefinition objects launched for
    -- this tuning job.
    CreateHyperParameterTuningJob
-> Maybe (NonEmpty HyperParameterTrainingJobDefinition)
trainingJobDefinitions :: Prelude.Maybe (Prelude.NonEmpty HyperParameterTrainingJobDefinition),
    -- | Specifies the configuration for starting the hyperparameter tuning job
    -- using one or more previous tuning jobs as a starting point. The results
    -- of previous tuning jobs are used to inform which combinations of
    -- hyperparameters to search over in the new tuning job.
    --
    -- All training jobs launched by the new hyperparameter tuning job are
    -- evaluated by using the objective metric. If you specify
    -- @IDENTICAL_DATA_AND_ALGORITHM@ as the @WarmStartType@ value for the warm
    -- start configuration, the training job that performs the best in the new
    -- tuning job is compared to the best training jobs from the parent tuning
    -- jobs. From these, the training job that performs the best as measured by
    -- the objective metric is returned as the overall best training job.
    --
    -- All training jobs launched by parent hyperparameter tuning jobs and the
    -- new hyperparameter tuning jobs count against the limit of training jobs
    -- for the tuning job.
    CreateHyperParameterTuningJob
-> Maybe HyperParameterTuningJobWarmStartConfig
warmStartConfig :: Prelude.Maybe HyperParameterTuningJobWarmStartConfig,
    -- | The name of the tuning job. This name is the prefix for the names of all
    -- training jobs that this tuning job launches. The name must be unique
    -- within the same Amazon Web Services account and Amazon Web Services
    -- Region. The name must have 1 to 32 characters. Valid characters are a-z,
    -- A-Z, 0-9, and : + = \@ _ % - (hyphen). The name is not case sensitive.
    CreateHyperParameterTuningJob -> Text
hyperParameterTuningJobName :: Prelude.Text,
    -- | The HyperParameterTuningJobConfig object that describes the tuning job,
    -- including the search strategy, the objective metric used to evaluate
    -- training jobs, ranges of parameters to search, and resource limits for
    -- the tuning job. For more information, see
    -- <https://docs.aws.amazon.com/sagemaker/latest/dg/automatic-model-tuning-how-it-works.html How Hyperparameter Tuning Works>.
    CreateHyperParameterTuningJob -> HyperParameterTuningJobConfig
hyperParameterTuningJobConfig :: HyperParameterTuningJobConfig
  }
  deriving (CreateHyperParameterTuningJob
-> CreateHyperParameterTuningJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateHyperParameterTuningJob
-> CreateHyperParameterTuningJob -> Bool
$c/= :: CreateHyperParameterTuningJob
-> CreateHyperParameterTuningJob -> Bool
== :: CreateHyperParameterTuningJob
-> CreateHyperParameterTuningJob -> Bool
$c== :: CreateHyperParameterTuningJob
-> CreateHyperParameterTuningJob -> Bool
Prelude.Eq, ReadPrec [CreateHyperParameterTuningJob]
ReadPrec CreateHyperParameterTuningJob
Int -> ReadS CreateHyperParameterTuningJob
ReadS [CreateHyperParameterTuningJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateHyperParameterTuningJob]
$creadListPrec :: ReadPrec [CreateHyperParameterTuningJob]
readPrec :: ReadPrec CreateHyperParameterTuningJob
$creadPrec :: ReadPrec CreateHyperParameterTuningJob
readList :: ReadS [CreateHyperParameterTuningJob]
$creadList :: ReadS [CreateHyperParameterTuningJob]
readsPrec :: Int -> ReadS CreateHyperParameterTuningJob
$creadsPrec :: Int -> ReadS CreateHyperParameterTuningJob
Prelude.Read, Int -> CreateHyperParameterTuningJob -> ShowS
[CreateHyperParameterTuningJob] -> ShowS
CreateHyperParameterTuningJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateHyperParameterTuningJob] -> ShowS
$cshowList :: [CreateHyperParameterTuningJob] -> ShowS
show :: CreateHyperParameterTuningJob -> String
$cshow :: CreateHyperParameterTuningJob -> String
showsPrec :: Int -> CreateHyperParameterTuningJob -> ShowS
$cshowsPrec :: Int -> CreateHyperParameterTuningJob -> ShowS
Prelude.Show, forall x.
Rep CreateHyperParameterTuningJob x
-> CreateHyperParameterTuningJob
forall x.
CreateHyperParameterTuningJob
-> Rep CreateHyperParameterTuningJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateHyperParameterTuningJob x
-> CreateHyperParameterTuningJob
$cfrom :: forall x.
CreateHyperParameterTuningJob
-> Rep CreateHyperParameterTuningJob x
Prelude.Generic)

-- |
-- Create a value of 'CreateHyperParameterTuningJob' 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:
--
-- 'tags', 'createHyperParameterTuningJob_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>.
--
-- Tags that you specify for the tuning job are also added to all training
-- jobs that the tuning job launches.
--
-- 'trainingJobDefinition', 'createHyperParameterTuningJob_trainingJobDefinition' - The HyperParameterTrainingJobDefinition object that describes the
-- training jobs that this tuning job launches, including static
-- hyperparameters, input data configuration, output data configuration,
-- resource configuration, and stopping condition.
--
-- 'trainingJobDefinitions', 'createHyperParameterTuningJob_trainingJobDefinitions' - A list of the HyperParameterTrainingJobDefinition objects launched for
-- this tuning job.
--
-- 'warmStartConfig', 'createHyperParameterTuningJob_warmStartConfig' - Specifies the configuration for starting the hyperparameter tuning job
-- using one or more previous tuning jobs as a starting point. The results
-- of previous tuning jobs are used to inform which combinations of
-- hyperparameters to search over in the new tuning job.
--
-- All training jobs launched by the new hyperparameter tuning job are
-- evaluated by using the objective metric. If you specify
-- @IDENTICAL_DATA_AND_ALGORITHM@ as the @WarmStartType@ value for the warm
-- start configuration, the training job that performs the best in the new
-- tuning job is compared to the best training jobs from the parent tuning
-- jobs. From these, the training job that performs the best as measured by
-- the objective metric is returned as the overall best training job.
--
-- All training jobs launched by parent hyperparameter tuning jobs and the
-- new hyperparameter tuning jobs count against the limit of training jobs
-- for the tuning job.
--
-- 'hyperParameterTuningJobName', 'createHyperParameterTuningJob_hyperParameterTuningJobName' - The name of the tuning job. This name is the prefix for the names of all
-- training jobs that this tuning job launches. The name must be unique
-- within the same Amazon Web Services account and Amazon Web Services
-- Region. The name must have 1 to 32 characters. Valid characters are a-z,
-- A-Z, 0-9, and : + = \@ _ % - (hyphen). The name is not case sensitive.
--
-- 'hyperParameterTuningJobConfig', 'createHyperParameterTuningJob_hyperParameterTuningJobConfig' - The HyperParameterTuningJobConfig object that describes the tuning job,
-- including the search strategy, the objective metric used to evaluate
-- training jobs, ranges of parameters to search, and resource limits for
-- the tuning job. For more information, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/automatic-model-tuning-how-it-works.html How Hyperparameter Tuning Works>.
newCreateHyperParameterTuningJob ::
  -- | 'hyperParameterTuningJobName'
  Prelude.Text ->
  -- | 'hyperParameterTuningJobConfig'
  HyperParameterTuningJobConfig ->
  CreateHyperParameterTuningJob
newCreateHyperParameterTuningJob :: Text
-> HyperParameterTuningJobConfig -> CreateHyperParameterTuningJob
newCreateHyperParameterTuningJob
  Text
pHyperParameterTuningJobName_
  HyperParameterTuningJobConfig
pHyperParameterTuningJobConfig_ =
    CreateHyperParameterTuningJob'
      { $sel:tags:CreateHyperParameterTuningJob' :: Maybe [Tag]
tags =
          forall a. Maybe a
Prelude.Nothing,
        $sel:trainingJobDefinition:CreateHyperParameterTuningJob' :: Maybe HyperParameterTrainingJobDefinition
trainingJobDefinition = forall a. Maybe a
Prelude.Nothing,
        $sel:trainingJobDefinitions:CreateHyperParameterTuningJob' :: Maybe (NonEmpty HyperParameterTrainingJobDefinition)
trainingJobDefinitions = forall a. Maybe a
Prelude.Nothing,
        $sel:warmStartConfig:CreateHyperParameterTuningJob' :: Maybe HyperParameterTuningJobWarmStartConfig
warmStartConfig = forall a. Maybe a
Prelude.Nothing,
        $sel:hyperParameterTuningJobName:CreateHyperParameterTuningJob' :: Text
hyperParameterTuningJobName =
          Text
pHyperParameterTuningJobName_,
        $sel:hyperParameterTuningJobConfig:CreateHyperParameterTuningJob' :: HyperParameterTuningJobConfig
hyperParameterTuningJobConfig =
          HyperParameterTuningJobConfig
pHyperParameterTuningJobConfig_
      }

-- | 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>.
--
-- Tags that you specify for the tuning job are also added to all training
-- jobs that the tuning job launches.
createHyperParameterTuningJob_tags :: Lens.Lens' CreateHyperParameterTuningJob (Prelude.Maybe [Tag])
createHyperParameterTuningJob_tags :: Lens' CreateHyperParameterTuningJob (Maybe [Tag])
createHyperParameterTuningJob_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHyperParameterTuningJob' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateHyperParameterTuningJob' :: CreateHyperParameterTuningJob -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateHyperParameterTuningJob
s@CreateHyperParameterTuningJob' {} Maybe [Tag]
a -> CreateHyperParameterTuningJob
s {$sel:tags:CreateHyperParameterTuningJob' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateHyperParameterTuningJob) 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 HyperParameterTrainingJobDefinition object that describes the
-- training jobs that this tuning job launches, including static
-- hyperparameters, input data configuration, output data configuration,
-- resource configuration, and stopping condition.
createHyperParameterTuningJob_trainingJobDefinition :: Lens.Lens' CreateHyperParameterTuningJob (Prelude.Maybe HyperParameterTrainingJobDefinition)
createHyperParameterTuningJob_trainingJobDefinition :: Lens'
  CreateHyperParameterTuningJob
  (Maybe HyperParameterTrainingJobDefinition)
createHyperParameterTuningJob_trainingJobDefinition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHyperParameterTuningJob' {Maybe HyperParameterTrainingJobDefinition
trainingJobDefinition :: Maybe HyperParameterTrainingJobDefinition
$sel:trainingJobDefinition:CreateHyperParameterTuningJob' :: CreateHyperParameterTuningJob
-> Maybe HyperParameterTrainingJobDefinition
trainingJobDefinition} -> Maybe HyperParameterTrainingJobDefinition
trainingJobDefinition) (\s :: CreateHyperParameterTuningJob
s@CreateHyperParameterTuningJob' {} Maybe HyperParameterTrainingJobDefinition
a -> CreateHyperParameterTuningJob
s {$sel:trainingJobDefinition:CreateHyperParameterTuningJob' :: Maybe HyperParameterTrainingJobDefinition
trainingJobDefinition = Maybe HyperParameterTrainingJobDefinition
a} :: CreateHyperParameterTuningJob)

-- | A list of the HyperParameterTrainingJobDefinition objects launched for
-- this tuning job.
createHyperParameterTuningJob_trainingJobDefinitions :: Lens.Lens' CreateHyperParameterTuningJob (Prelude.Maybe (Prelude.NonEmpty HyperParameterTrainingJobDefinition))
createHyperParameterTuningJob_trainingJobDefinitions :: Lens'
  CreateHyperParameterTuningJob
  (Maybe (NonEmpty HyperParameterTrainingJobDefinition))
createHyperParameterTuningJob_trainingJobDefinitions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHyperParameterTuningJob' {Maybe (NonEmpty HyperParameterTrainingJobDefinition)
trainingJobDefinitions :: Maybe (NonEmpty HyperParameterTrainingJobDefinition)
$sel:trainingJobDefinitions:CreateHyperParameterTuningJob' :: CreateHyperParameterTuningJob
-> Maybe (NonEmpty HyperParameterTrainingJobDefinition)
trainingJobDefinitions} -> Maybe (NonEmpty HyperParameterTrainingJobDefinition)
trainingJobDefinitions) (\s :: CreateHyperParameterTuningJob
s@CreateHyperParameterTuningJob' {} Maybe (NonEmpty HyperParameterTrainingJobDefinition)
a -> CreateHyperParameterTuningJob
s {$sel:trainingJobDefinitions:CreateHyperParameterTuningJob' :: Maybe (NonEmpty HyperParameterTrainingJobDefinition)
trainingJobDefinitions = Maybe (NonEmpty HyperParameterTrainingJobDefinition)
a} :: CreateHyperParameterTuningJob) 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

-- | Specifies the configuration for starting the hyperparameter tuning job
-- using one or more previous tuning jobs as a starting point. The results
-- of previous tuning jobs are used to inform which combinations of
-- hyperparameters to search over in the new tuning job.
--
-- All training jobs launched by the new hyperparameter tuning job are
-- evaluated by using the objective metric. If you specify
-- @IDENTICAL_DATA_AND_ALGORITHM@ as the @WarmStartType@ value for the warm
-- start configuration, the training job that performs the best in the new
-- tuning job is compared to the best training jobs from the parent tuning
-- jobs. From these, the training job that performs the best as measured by
-- the objective metric is returned as the overall best training job.
--
-- All training jobs launched by parent hyperparameter tuning jobs and the
-- new hyperparameter tuning jobs count against the limit of training jobs
-- for the tuning job.
createHyperParameterTuningJob_warmStartConfig :: Lens.Lens' CreateHyperParameterTuningJob (Prelude.Maybe HyperParameterTuningJobWarmStartConfig)
createHyperParameterTuningJob_warmStartConfig :: Lens'
  CreateHyperParameterTuningJob
  (Maybe HyperParameterTuningJobWarmStartConfig)
createHyperParameterTuningJob_warmStartConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHyperParameterTuningJob' {Maybe HyperParameterTuningJobWarmStartConfig
warmStartConfig :: Maybe HyperParameterTuningJobWarmStartConfig
$sel:warmStartConfig:CreateHyperParameterTuningJob' :: CreateHyperParameterTuningJob
-> Maybe HyperParameterTuningJobWarmStartConfig
warmStartConfig} -> Maybe HyperParameterTuningJobWarmStartConfig
warmStartConfig) (\s :: CreateHyperParameterTuningJob
s@CreateHyperParameterTuningJob' {} Maybe HyperParameterTuningJobWarmStartConfig
a -> CreateHyperParameterTuningJob
s {$sel:warmStartConfig:CreateHyperParameterTuningJob' :: Maybe HyperParameterTuningJobWarmStartConfig
warmStartConfig = Maybe HyperParameterTuningJobWarmStartConfig
a} :: CreateHyperParameterTuningJob)

-- | The name of the tuning job. This name is the prefix for the names of all
-- training jobs that this tuning job launches. The name must be unique
-- within the same Amazon Web Services account and Amazon Web Services
-- Region. The name must have 1 to 32 characters. Valid characters are a-z,
-- A-Z, 0-9, and : + = \@ _ % - (hyphen). The name is not case sensitive.
createHyperParameterTuningJob_hyperParameterTuningJobName :: Lens.Lens' CreateHyperParameterTuningJob Prelude.Text
createHyperParameterTuningJob_hyperParameterTuningJobName :: Lens' CreateHyperParameterTuningJob Text
createHyperParameterTuningJob_hyperParameterTuningJobName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHyperParameterTuningJob' {Text
hyperParameterTuningJobName :: Text
$sel:hyperParameterTuningJobName:CreateHyperParameterTuningJob' :: CreateHyperParameterTuningJob -> Text
hyperParameterTuningJobName} -> Text
hyperParameterTuningJobName) (\s :: CreateHyperParameterTuningJob
s@CreateHyperParameterTuningJob' {} Text
a -> CreateHyperParameterTuningJob
s {$sel:hyperParameterTuningJobName:CreateHyperParameterTuningJob' :: Text
hyperParameterTuningJobName = Text
a} :: CreateHyperParameterTuningJob)

-- | The HyperParameterTuningJobConfig object that describes the tuning job,
-- including the search strategy, the objective metric used to evaluate
-- training jobs, ranges of parameters to search, and resource limits for
-- the tuning job. For more information, see
-- <https://docs.aws.amazon.com/sagemaker/latest/dg/automatic-model-tuning-how-it-works.html How Hyperparameter Tuning Works>.
createHyperParameterTuningJob_hyperParameterTuningJobConfig :: Lens.Lens' CreateHyperParameterTuningJob HyperParameterTuningJobConfig
createHyperParameterTuningJob_hyperParameterTuningJobConfig :: Lens' CreateHyperParameterTuningJob HyperParameterTuningJobConfig
createHyperParameterTuningJob_hyperParameterTuningJobConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHyperParameterTuningJob' {HyperParameterTuningJobConfig
hyperParameterTuningJobConfig :: HyperParameterTuningJobConfig
$sel:hyperParameterTuningJobConfig:CreateHyperParameterTuningJob' :: CreateHyperParameterTuningJob -> HyperParameterTuningJobConfig
hyperParameterTuningJobConfig} -> HyperParameterTuningJobConfig
hyperParameterTuningJobConfig) (\s :: CreateHyperParameterTuningJob
s@CreateHyperParameterTuningJob' {} HyperParameterTuningJobConfig
a -> CreateHyperParameterTuningJob
s {$sel:hyperParameterTuningJobConfig:CreateHyperParameterTuningJob' :: HyperParameterTuningJobConfig
hyperParameterTuningJobConfig = HyperParameterTuningJobConfig
a} :: CreateHyperParameterTuningJob)

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

instance
  Prelude.Hashable
    CreateHyperParameterTuningJob
  where
  hashWithSalt :: Int -> CreateHyperParameterTuningJob -> Int
hashWithSalt Int
_salt CreateHyperParameterTuningJob' {Maybe [Tag]
Maybe (NonEmpty HyperParameterTrainingJobDefinition)
Maybe HyperParameterTuningJobWarmStartConfig
Maybe HyperParameterTrainingJobDefinition
Text
HyperParameterTuningJobConfig
hyperParameterTuningJobConfig :: HyperParameterTuningJobConfig
hyperParameterTuningJobName :: Text
warmStartConfig :: Maybe HyperParameterTuningJobWarmStartConfig
trainingJobDefinitions :: Maybe (NonEmpty HyperParameterTrainingJobDefinition)
trainingJobDefinition :: Maybe HyperParameterTrainingJobDefinition
tags :: Maybe [Tag]
$sel:hyperParameterTuningJobConfig:CreateHyperParameterTuningJob' :: CreateHyperParameterTuningJob -> HyperParameterTuningJobConfig
$sel:hyperParameterTuningJobName:CreateHyperParameterTuningJob' :: CreateHyperParameterTuningJob -> Text
$sel:warmStartConfig:CreateHyperParameterTuningJob' :: CreateHyperParameterTuningJob
-> Maybe HyperParameterTuningJobWarmStartConfig
$sel:trainingJobDefinitions:CreateHyperParameterTuningJob' :: CreateHyperParameterTuningJob
-> Maybe (NonEmpty HyperParameterTrainingJobDefinition)
$sel:trainingJobDefinition:CreateHyperParameterTuningJob' :: CreateHyperParameterTuningJob
-> Maybe HyperParameterTrainingJobDefinition
$sel:tags:CreateHyperParameterTuningJob' :: CreateHyperParameterTuningJob -> Maybe [Tag]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HyperParameterTrainingJobDefinition
trainingJobDefinition
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty HyperParameterTrainingJobDefinition)
trainingJobDefinitions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HyperParameterTuningJobWarmStartConfig
warmStartConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
hyperParameterTuningJobName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HyperParameterTuningJobConfig
hyperParameterTuningJobConfig

instance Prelude.NFData CreateHyperParameterTuningJob where
  rnf :: CreateHyperParameterTuningJob -> ()
rnf CreateHyperParameterTuningJob' {Maybe [Tag]
Maybe (NonEmpty HyperParameterTrainingJobDefinition)
Maybe HyperParameterTuningJobWarmStartConfig
Maybe HyperParameterTrainingJobDefinition
Text
HyperParameterTuningJobConfig
hyperParameterTuningJobConfig :: HyperParameterTuningJobConfig
hyperParameterTuningJobName :: Text
warmStartConfig :: Maybe HyperParameterTuningJobWarmStartConfig
trainingJobDefinitions :: Maybe (NonEmpty HyperParameterTrainingJobDefinition)
trainingJobDefinition :: Maybe HyperParameterTrainingJobDefinition
tags :: Maybe [Tag]
$sel:hyperParameterTuningJobConfig:CreateHyperParameterTuningJob' :: CreateHyperParameterTuningJob -> HyperParameterTuningJobConfig
$sel:hyperParameterTuningJobName:CreateHyperParameterTuningJob' :: CreateHyperParameterTuningJob -> Text
$sel:warmStartConfig:CreateHyperParameterTuningJob' :: CreateHyperParameterTuningJob
-> Maybe HyperParameterTuningJobWarmStartConfig
$sel:trainingJobDefinitions:CreateHyperParameterTuningJob' :: CreateHyperParameterTuningJob
-> Maybe (NonEmpty HyperParameterTrainingJobDefinition)
$sel:trainingJobDefinition:CreateHyperParameterTuningJob' :: CreateHyperParameterTuningJob
-> Maybe HyperParameterTrainingJobDefinition
$sel:tags:CreateHyperParameterTuningJob' :: CreateHyperParameterTuningJob -> Maybe [Tag]
..} =
    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 HyperParameterTrainingJobDefinition
trainingJobDefinition
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty HyperParameterTrainingJobDefinition)
trainingJobDefinitions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HyperParameterTuningJobWarmStartConfig
warmStartConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
hyperParameterTuningJobName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf HyperParameterTuningJobConfig
hyperParameterTuningJobConfig

instance Data.ToHeaders CreateHyperParameterTuningJob where
  toHeaders :: CreateHyperParameterTuningJob -> 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.CreateHyperParameterTuningJob" ::
                          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 CreateHyperParameterTuningJob where
  toJSON :: CreateHyperParameterTuningJob -> Value
toJSON CreateHyperParameterTuningJob' {Maybe [Tag]
Maybe (NonEmpty HyperParameterTrainingJobDefinition)
Maybe HyperParameterTuningJobWarmStartConfig
Maybe HyperParameterTrainingJobDefinition
Text
HyperParameterTuningJobConfig
hyperParameterTuningJobConfig :: HyperParameterTuningJobConfig
hyperParameterTuningJobName :: Text
warmStartConfig :: Maybe HyperParameterTuningJobWarmStartConfig
trainingJobDefinitions :: Maybe (NonEmpty HyperParameterTrainingJobDefinition)
trainingJobDefinition :: Maybe HyperParameterTrainingJobDefinition
tags :: Maybe [Tag]
$sel:hyperParameterTuningJobConfig:CreateHyperParameterTuningJob' :: CreateHyperParameterTuningJob -> HyperParameterTuningJobConfig
$sel:hyperParameterTuningJobName:CreateHyperParameterTuningJob' :: CreateHyperParameterTuningJob -> Text
$sel:warmStartConfig:CreateHyperParameterTuningJob' :: CreateHyperParameterTuningJob
-> Maybe HyperParameterTuningJobWarmStartConfig
$sel:trainingJobDefinitions:CreateHyperParameterTuningJob' :: CreateHyperParameterTuningJob
-> Maybe (NonEmpty HyperParameterTrainingJobDefinition)
$sel:trainingJobDefinition:CreateHyperParameterTuningJob' :: CreateHyperParameterTuningJob
-> Maybe HyperParameterTrainingJobDefinition
$sel:tags:CreateHyperParameterTuningJob' :: CreateHyperParameterTuningJob -> Maybe [Tag]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"TrainingJobDefinition" 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 HyperParameterTrainingJobDefinition
trainingJobDefinition,
            (Key
"TrainingJobDefinitions" 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 HyperParameterTrainingJobDefinition)
trainingJobDefinitions,
            (Key
"WarmStartConfig" 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 HyperParameterTuningJobWarmStartConfig
warmStartConfig,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"HyperParameterTuningJobName"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
hyperParameterTuningJobName
              ),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"HyperParameterTuningJobConfig"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= HyperParameterTuningJobConfig
hyperParameterTuningJobConfig
              )
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateHyperParameterTuningJobResponse' 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', 'createHyperParameterTuningJobResponse_httpStatus' - The response's http status code.
--
-- 'hyperParameterTuningJobArn', 'createHyperParameterTuningJobResponse_hyperParameterTuningJobArn' - The Amazon Resource Name (ARN) of the tuning job. SageMaker assigns an
-- ARN to a hyperparameter tuning job when you create it.
newCreateHyperParameterTuningJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'hyperParameterTuningJobArn'
  Prelude.Text ->
  CreateHyperParameterTuningJobResponse
newCreateHyperParameterTuningJobResponse :: Int -> Text -> CreateHyperParameterTuningJobResponse
newCreateHyperParameterTuningJobResponse
  Int
pHttpStatus_
  Text
pHyperParameterTuningJobArn_ =
    CreateHyperParameterTuningJobResponse'
      { $sel:httpStatus:CreateHyperParameterTuningJobResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:hyperParameterTuningJobArn:CreateHyperParameterTuningJobResponse' :: Text
hyperParameterTuningJobArn =
          Text
pHyperParameterTuningJobArn_
      }

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

-- | The Amazon Resource Name (ARN) of the tuning job. SageMaker assigns an
-- ARN to a hyperparameter tuning job when you create it.
createHyperParameterTuningJobResponse_hyperParameterTuningJobArn :: Lens.Lens' CreateHyperParameterTuningJobResponse Prelude.Text
createHyperParameterTuningJobResponse_hyperParameterTuningJobArn :: Lens' CreateHyperParameterTuningJobResponse Text
createHyperParameterTuningJobResponse_hyperParameterTuningJobArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHyperParameterTuningJobResponse' {Text
hyperParameterTuningJobArn :: Text
$sel:hyperParameterTuningJobArn:CreateHyperParameterTuningJobResponse' :: CreateHyperParameterTuningJobResponse -> Text
hyperParameterTuningJobArn} -> Text
hyperParameterTuningJobArn) (\s :: CreateHyperParameterTuningJobResponse
s@CreateHyperParameterTuningJobResponse' {} Text
a -> CreateHyperParameterTuningJobResponse
s {$sel:hyperParameterTuningJobArn:CreateHyperParameterTuningJobResponse' :: Text
hyperParameterTuningJobArn = Text
a} :: CreateHyperParameterTuningJobResponse)

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