{-# 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.UpdateTrainingJob
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Update a model training job to request a new Debugger profiling
-- configuration or to change warm pool retention length.
module Amazonka.SageMaker.UpdateTrainingJob
  ( -- * Creating a Request
    UpdateTrainingJob (..),
    newUpdateTrainingJob,

    -- * Request Lenses
    updateTrainingJob_profilerConfig,
    updateTrainingJob_profilerRuleConfigurations,
    updateTrainingJob_resourceConfig,
    updateTrainingJob_trainingJobName,

    -- * Destructuring the Response
    UpdateTrainingJobResponse (..),
    newUpdateTrainingJobResponse,

    -- * Response Lenses
    updateTrainingJobResponse_httpStatus,
    updateTrainingJobResponse_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:/ 'newUpdateTrainingJob' smart constructor.
data UpdateTrainingJob = UpdateTrainingJob'
  { -- | Configuration information for Amazon SageMaker Debugger system
    -- monitoring, framework profiling, and storage paths.
    UpdateTrainingJob -> Maybe ProfilerConfigForUpdate
profilerConfig :: Prelude.Maybe ProfilerConfigForUpdate,
    -- | Configuration information for Amazon SageMaker Debugger rules for
    -- profiling system and framework metrics.
    UpdateTrainingJob -> Maybe [ProfilerRuleConfiguration]
profilerRuleConfigurations :: Prelude.Maybe [ProfilerRuleConfiguration],
    -- | The training job @ResourceConfig@ to update warm pool retention length.
    UpdateTrainingJob -> Maybe ResourceConfigForUpdate
resourceConfig :: Prelude.Maybe ResourceConfigForUpdate,
    -- | The name of a training job to update the Debugger profiling
    -- configuration.
    UpdateTrainingJob -> Text
trainingJobName :: Prelude.Text
  }
  deriving (UpdateTrainingJob -> UpdateTrainingJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateTrainingJob -> UpdateTrainingJob -> Bool
$c/= :: UpdateTrainingJob -> UpdateTrainingJob -> Bool
== :: UpdateTrainingJob -> UpdateTrainingJob -> Bool
$c== :: UpdateTrainingJob -> UpdateTrainingJob -> Bool
Prelude.Eq, ReadPrec [UpdateTrainingJob]
ReadPrec UpdateTrainingJob
Int -> ReadS UpdateTrainingJob
ReadS [UpdateTrainingJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateTrainingJob]
$creadListPrec :: ReadPrec [UpdateTrainingJob]
readPrec :: ReadPrec UpdateTrainingJob
$creadPrec :: ReadPrec UpdateTrainingJob
readList :: ReadS [UpdateTrainingJob]
$creadList :: ReadS [UpdateTrainingJob]
readsPrec :: Int -> ReadS UpdateTrainingJob
$creadsPrec :: Int -> ReadS UpdateTrainingJob
Prelude.Read, Int -> UpdateTrainingJob -> ShowS
[UpdateTrainingJob] -> ShowS
UpdateTrainingJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateTrainingJob] -> ShowS
$cshowList :: [UpdateTrainingJob] -> ShowS
show :: UpdateTrainingJob -> String
$cshow :: UpdateTrainingJob -> String
showsPrec :: Int -> UpdateTrainingJob -> ShowS
$cshowsPrec :: Int -> UpdateTrainingJob -> ShowS
Prelude.Show, forall x. Rep UpdateTrainingJob x -> UpdateTrainingJob
forall x. UpdateTrainingJob -> Rep UpdateTrainingJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateTrainingJob x -> UpdateTrainingJob
$cfrom :: forall x. UpdateTrainingJob -> Rep UpdateTrainingJob x
Prelude.Generic)

-- |
-- Create a value of 'UpdateTrainingJob' 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:
--
-- 'profilerConfig', 'updateTrainingJob_profilerConfig' - Configuration information for Amazon SageMaker Debugger system
-- monitoring, framework profiling, and storage paths.
--
-- 'profilerRuleConfigurations', 'updateTrainingJob_profilerRuleConfigurations' - Configuration information for Amazon SageMaker Debugger rules for
-- profiling system and framework metrics.
--
-- 'resourceConfig', 'updateTrainingJob_resourceConfig' - The training job @ResourceConfig@ to update warm pool retention length.
--
-- 'trainingJobName', 'updateTrainingJob_trainingJobName' - The name of a training job to update the Debugger profiling
-- configuration.
newUpdateTrainingJob ::
  -- | 'trainingJobName'
  Prelude.Text ->
  UpdateTrainingJob
newUpdateTrainingJob :: Text -> UpdateTrainingJob
newUpdateTrainingJob Text
pTrainingJobName_ =
  UpdateTrainingJob'
    { $sel:profilerConfig:UpdateTrainingJob' :: Maybe ProfilerConfigForUpdate
profilerConfig =
        forall a. Maybe a
Prelude.Nothing,
      $sel:profilerRuleConfigurations:UpdateTrainingJob' :: Maybe [ProfilerRuleConfiguration]
profilerRuleConfigurations = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceConfig:UpdateTrainingJob' :: Maybe ResourceConfigForUpdate
resourceConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:trainingJobName:UpdateTrainingJob' :: Text
trainingJobName = Text
pTrainingJobName_
    }

-- | Configuration information for Amazon SageMaker Debugger system
-- monitoring, framework profiling, and storage paths.
updateTrainingJob_profilerConfig :: Lens.Lens' UpdateTrainingJob (Prelude.Maybe ProfilerConfigForUpdate)
updateTrainingJob_profilerConfig :: Lens' UpdateTrainingJob (Maybe ProfilerConfigForUpdate)
updateTrainingJob_profilerConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTrainingJob' {Maybe ProfilerConfigForUpdate
profilerConfig :: Maybe ProfilerConfigForUpdate
$sel:profilerConfig:UpdateTrainingJob' :: UpdateTrainingJob -> Maybe ProfilerConfigForUpdate
profilerConfig} -> Maybe ProfilerConfigForUpdate
profilerConfig) (\s :: UpdateTrainingJob
s@UpdateTrainingJob' {} Maybe ProfilerConfigForUpdate
a -> UpdateTrainingJob
s {$sel:profilerConfig:UpdateTrainingJob' :: Maybe ProfilerConfigForUpdate
profilerConfig = Maybe ProfilerConfigForUpdate
a} :: UpdateTrainingJob)

-- | Configuration information for Amazon SageMaker Debugger rules for
-- profiling system and framework metrics.
updateTrainingJob_profilerRuleConfigurations :: Lens.Lens' UpdateTrainingJob (Prelude.Maybe [ProfilerRuleConfiguration])
updateTrainingJob_profilerRuleConfigurations :: Lens' UpdateTrainingJob (Maybe [ProfilerRuleConfiguration])
updateTrainingJob_profilerRuleConfigurations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTrainingJob' {Maybe [ProfilerRuleConfiguration]
profilerRuleConfigurations :: Maybe [ProfilerRuleConfiguration]
$sel:profilerRuleConfigurations:UpdateTrainingJob' :: UpdateTrainingJob -> Maybe [ProfilerRuleConfiguration]
profilerRuleConfigurations} -> Maybe [ProfilerRuleConfiguration]
profilerRuleConfigurations) (\s :: UpdateTrainingJob
s@UpdateTrainingJob' {} Maybe [ProfilerRuleConfiguration]
a -> UpdateTrainingJob
s {$sel:profilerRuleConfigurations:UpdateTrainingJob' :: Maybe [ProfilerRuleConfiguration]
profilerRuleConfigurations = Maybe [ProfilerRuleConfiguration]
a} :: UpdateTrainingJob) 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 training job @ResourceConfig@ to update warm pool retention length.
updateTrainingJob_resourceConfig :: Lens.Lens' UpdateTrainingJob (Prelude.Maybe ResourceConfigForUpdate)
updateTrainingJob_resourceConfig :: Lens' UpdateTrainingJob (Maybe ResourceConfigForUpdate)
updateTrainingJob_resourceConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTrainingJob' {Maybe ResourceConfigForUpdate
resourceConfig :: Maybe ResourceConfigForUpdate
$sel:resourceConfig:UpdateTrainingJob' :: UpdateTrainingJob -> Maybe ResourceConfigForUpdate
resourceConfig} -> Maybe ResourceConfigForUpdate
resourceConfig) (\s :: UpdateTrainingJob
s@UpdateTrainingJob' {} Maybe ResourceConfigForUpdate
a -> UpdateTrainingJob
s {$sel:resourceConfig:UpdateTrainingJob' :: Maybe ResourceConfigForUpdate
resourceConfig = Maybe ResourceConfigForUpdate
a} :: UpdateTrainingJob)

-- | The name of a training job to update the Debugger profiling
-- configuration.
updateTrainingJob_trainingJobName :: Lens.Lens' UpdateTrainingJob Prelude.Text
updateTrainingJob_trainingJobName :: Lens' UpdateTrainingJob Text
updateTrainingJob_trainingJobName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTrainingJob' {Text
trainingJobName :: Text
$sel:trainingJobName:UpdateTrainingJob' :: UpdateTrainingJob -> Text
trainingJobName} -> Text
trainingJobName) (\s :: UpdateTrainingJob
s@UpdateTrainingJob' {} Text
a -> UpdateTrainingJob
s {$sel:trainingJobName:UpdateTrainingJob' :: Text
trainingJobName = Text
a} :: UpdateTrainingJob)

instance Core.AWSRequest UpdateTrainingJob where
  type
    AWSResponse UpdateTrainingJob =
      UpdateTrainingJobResponse
  request :: (Service -> Service)
-> UpdateTrainingJob -> Request UpdateTrainingJob
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 UpdateTrainingJob
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateTrainingJob)))
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 -> UpdateTrainingJobResponse
UpdateTrainingJobResponse'
            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 UpdateTrainingJob where
  hashWithSalt :: Int -> UpdateTrainingJob -> Int
hashWithSalt Int
_salt UpdateTrainingJob' {Maybe [ProfilerRuleConfiguration]
Maybe ProfilerConfigForUpdate
Maybe ResourceConfigForUpdate
Text
trainingJobName :: Text
resourceConfig :: Maybe ResourceConfigForUpdate
profilerRuleConfigurations :: Maybe [ProfilerRuleConfiguration]
profilerConfig :: Maybe ProfilerConfigForUpdate
$sel:trainingJobName:UpdateTrainingJob' :: UpdateTrainingJob -> Text
$sel:resourceConfig:UpdateTrainingJob' :: UpdateTrainingJob -> Maybe ResourceConfigForUpdate
$sel:profilerRuleConfigurations:UpdateTrainingJob' :: UpdateTrainingJob -> Maybe [ProfilerRuleConfiguration]
$sel:profilerConfig:UpdateTrainingJob' :: UpdateTrainingJob -> Maybe ProfilerConfigForUpdate
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ProfilerConfigForUpdate
profilerConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ProfilerRuleConfiguration]
profilerRuleConfigurations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ResourceConfigForUpdate
resourceConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
trainingJobName

instance Prelude.NFData UpdateTrainingJob where
  rnf :: UpdateTrainingJob -> ()
rnf UpdateTrainingJob' {Maybe [ProfilerRuleConfiguration]
Maybe ProfilerConfigForUpdate
Maybe ResourceConfigForUpdate
Text
trainingJobName :: Text
resourceConfig :: Maybe ResourceConfigForUpdate
profilerRuleConfigurations :: Maybe [ProfilerRuleConfiguration]
profilerConfig :: Maybe ProfilerConfigForUpdate
$sel:trainingJobName:UpdateTrainingJob' :: UpdateTrainingJob -> Text
$sel:resourceConfig:UpdateTrainingJob' :: UpdateTrainingJob -> Maybe ResourceConfigForUpdate
$sel:profilerRuleConfigurations:UpdateTrainingJob' :: UpdateTrainingJob -> Maybe [ProfilerRuleConfiguration]
$sel:profilerConfig:UpdateTrainingJob' :: UpdateTrainingJob -> Maybe ProfilerConfigForUpdate
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ProfilerConfigForUpdate
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 ResourceConfigForUpdate
resourceConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
trainingJobName

instance Data.ToHeaders UpdateTrainingJob where
  toHeaders :: UpdateTrainingJob -> 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.UpdateTrainingJob" ::
                          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 UpdateTrainingJob where
  toJSON :: UpdateTrainingJob -> Value
toJSON UpdateTrainingJob' {Maybe [ProfilerRuleConfiguration]
Maybe ProfilerConfigForUpdate
Maybe ResourceConfigForUpdate
Text
trainingJobName :: Text
resourceConfig :: Maybe ResourceConfigForUpdate
profilerRuleConfigurations :: Maybe [ProfilerRuleConfiguration]
profilerConfig :: Maybe ProfilerConfigForUpdate
$sel:trainingJobName:UpdateTrainingJob' :: UpdateTrainingJob -> Text
$sel:resourceConfig:UpdateTrainingJob' :: UpdateTrainingJob -> Maybe ResourceConfigForUpdate
$sel:profilerRuleConfigurations:UpdateTrainingJob' :: UpdateTrainingJob -> Maybe [ProfilerRuleConfiguration]
$sel:profilerConfig:UpdateTrainingJob' :: UpdateTrainingJob -> Maybe ProfilerConfigForUpdate
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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 ProfilerConfigForUpdate
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
"ResourceConfig" 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 ResourceConfigForUpdate
resourceConfig,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"TrainingJobName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
trainingJobName)
          ]
      )

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

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

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

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

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

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

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