{-# 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.Glue.GetMLTaskRun
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets details for a specific task run on a machine learning transform.
-- Machine learning task runs are asynchronous tasks that Glue runs on your
-- behalf as part of various machine learning workflows. You can check the
-- stats of any task run by calling @GetMLTaskRun@ with the @TaskRunID@ and
-- its parent transform\'s @TransformID@.
module Amazonka.Glue.GetMLTaskRun
  ( -- * Creating a Request
    GetMLTaskRun (..),
    newGetMLTaskRun,

    -- * Request Lenses
    getMLTaskRun_transformId,
    getMLTaskRun_taskRunId,

    -- * Destructuring the Response
    GetMLTaskRunResponse (..),
    newGetMLTaskRunResponse,

    -- * Response Lenses
    getMLTaskRunResponse_completedOn,
    getMLTaskRunResponse_errorString,
    getMLTaskRunResponse_executionTime,
    getMLTaskRunResponse_lastModifiedOn,
    getMLTaskRunResponse_logGroupName,
    getMLTaskRunResponse_properties,
    getMLTaskRunResponse_startedOn,
    getMLTaskRunResponse_status,
    getMLTaskRunResponse_taskRunId,
    getMLTaskRunResponse_transformId,
    getMLTaskRunResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Glue.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetMLTaskRun' smart constructor.
data GetMLTaskRun = GetMLTaskRun'
  { -- | The unique identifier of the machine learning transform.
    GetMLTaskRun -> Text
transformId :: Prelude.Text,
    -- | The unique identifier of the task run.
    GetMLTaskRun -> Text
taskRunId :: Prelude.Text
  }
  deriving (GetMLTaskRun -> GetMLTaskRun -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetMLTaskRun -> GetMLTaskRun -> Bool
$c/= :: GetMLTaskRun -> GetMLTaskRun -> Bool
== :: GetMLTaskRun -> GetMLTaskRun -> Bool
$c== :: GetMLTaskRun -> GetMLTaskRun -> Bool
Prelude.Eq, ReadPrec [GetMLTaskRun]
ReadPrec GetMLTaskRun
Int -> ReadS GetMLTaskRun
ReadS [GetMLTaskRun]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetMLTaskRun]
$creadListPrec :: ReadPrec [GetMLTaskRun]
readPrec :: ReadPrec GetMLTaskRun
$creadPrec :: ReadPrec GetMLTaskRun
readList :: ReadS [GetMLTaskRun]
$creadList :: ReadS [GetMLTaskRun]
readsPrec :: Int -> ReadS GetMLTaskRun
$creadsPrec :: Int -> ReadS GetMLTaskRun
Prelude.Read, Int -> GetMLTaskRun -> ShowS
[GetMLTaskRun] -> ShowS
GetMLTaskRun -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetMLTaskRun] -> ShowS
$cshowList :: [GetMLTaskRun] -> ShowS
show :: GetMLTaskRun -> String
$cshow :: GetMLTaskRun -> String
showsPrec :: Int -> GetMLTaskRun -> ShowS
$cshowsPrec :: Int -> GetMLTaskRun -> ShowS
Prelude.Show, forall x. Rep GetMLTaskRun x -> GetMLTaskRun
forall x. GetMLTaskRun -> Rep GetMLTaskRun x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetMLTaskRun x -> GetMLTaskRun
$cfrom :: forall x. GetMLTaskRun -> Rep GetMLTaskRun x
Prelude.Generic)

-- |
-- Create a value of 'GetMLTaskRun' 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:
--
-- 'transformId', 'getMLTaskRun_transformId' - The unique identifier of the machine learning transform.
--
-- 'taskRunId', 'getMLTaskRun_taskRunId' - The unique identifier of the task run.
newGetMLTaskRun ::
  -- | 'transformId'
  Prelude.Text ->
  -- | 'taskRunId'
  Prelude.Text ->
  GetMLTaskRun
newGetMLTaskRun :: Text -> Text -> GetMLTaskRun
newGetMLTaskRun Text
pTransformId_ Text
pTaskRunId_ =
  GetMLTaskRun'
    { $sel:transformId:GetMLTaskRun' :: Text
transformId = Text
pTransformId_,
      $sel:taskRunId:GetMLTaskRun' :: Text
taskRunId = Text
pTaskRunId_
    }

-- | The unique identifier of the machine learning transform.
getMLTaskRun_transformId :: Lens.Lens' GetMLTaskRun Prelude.Text
getMLTaskRun_transformId :: Lens' GetMLTaskRun Text
getMLTaskRun_transformId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLTaskRun' {Text
transformId :: Text
$sel:transformId:GetMLTaskRun' :: GetMLTaskRun -> Text
transformId} -> Text
transformId) (\s :: GetMLTaskRun
s@GetMLTaskRun' {} Text
a -> GetMLTaskRun
s {$sel:transformId:GetMLTaskRun' :: Text
transformId = Text
a} :: GetMLTaskRun)

-- | The unique identifier of the task run.
getMLTaskRun_taskRunId :: Lens.Lens' GetMLTaskRun Prelude.Text
getMLTaskRun_taskRunId :: Lens' GetMLTaskRun Text
getMLTaskRun_taskRunId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLTaskRun' {Text
taskRunId :: Text
$sel:taskRunId:GetMLTaskRun' :: GetMLTaskRun -> Text
taskRunId} -> Text
taskRunId) (\s :: GetMLTaskRun
s@GetMLTaskRun' {} Text
a -> GetMLTaskRun
s {$sel:taskRunId:GetMLTaskRun' :: Text
taskRunId = Text
a} :: GetMLTaskRun)

instance Core.AWSRequest GetMLTaskRun where
  type AWSResponse GetMLTaskRun = GetMLTaskRunResponse
  request :: (Service -> Service) -> GetMLTaskRun -> Request GetMLTaskRun
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 GetMLTaskRun
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetMLTaskRun)))
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 ->
          Maybe POSIX
-> Maybe Text
-> Maybe Int
-> Maybe POSIX
-> Maybe Text
-> Maybe TaskRunProperties
-> Maybe POSIX
-> Maybe TaskStatusType
-> Maybe Text
-> Maybe Text
-> Int
-> GetMLTaskRunResponse
GetMLTaskRunResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"CompletedOn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ErrorString")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ExecutionTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"LastModifiedOn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"LogGroupName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Properties")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"StartedOn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Status")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"TaskRunId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"TransformId")
            forall (f :: * -> *) a b. Applicative f => 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))
      )

instance Prelude.Hashable GetMLTaskRun where
  hashWithSalt :: Int -> GetMLTaskRun -> Int
hashWithSalt Int
_salt GetMLTaskRun' {Text
taskRunId :: Text
transformId :: Text
$sel:taskRunId:GetMLTaskRun' :: GetMLTaskRun -> Text
$sel:transformId:GetMLTaskRun' :: GetMLTaskRun -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
transformId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
taskRunId

instance Prelude.NFData GetMLTaskRun where
  rnf :: GetMLTaskRun -> ()
rnf GetMLTaskRun' {Text
taskRunId :: Text
transformId :: Text
$sel:taskRunId:GetMLTaskRun' :: GetMLTaskRun -> Text
$sel:transformId:GetMLTaskRun' :: GetMLTaskRun -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
transformId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
taskRunId

instance Data.ToHeaders GetMLTaskRun where
  toHeaders :: GetMLTaskRun -> 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
"AWSGlue.GetMLTaskRun" :: 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 GetMLTaskRun where
  toJSON :: GetMLTaskRun -> Value
toJSON GetMLTaskRun' {Text
taskRunId :: Text
transformId :: Text
$sel:taskRunId:GetMLTaskRun' :: GetMLTaskRun -> Text
$sel:transformId:GetMLTaskRun' :: GetMLTaskRun -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"TransformId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
transformId),
            forall a. a -> Maybe a
Prelude.Just (Key
"TaskRunId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
taskRunId)
          ]
      )

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

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

-- | /See:/ 'newGetMLTaskRunResponse' smart constructor.
data GetMLTaskRunResponse = GetMLTaskRunResponse'
  { -- | The date and time when this task run was completed.
    GetMLTaskRunResponse -> Maybe POSIX
completedOn :: Prelude.Maybe Data.POSIX,
    -- | The error strings that are associated with the task run.
    GetMLTaskRunResponse -> Maybe Text
errorString :: Prelude.Maybe Prelude.Text,
    -- | The amount of time (in seconds) that the task run consumed resources.
    GetMLTaskRunResponse -> Maybe Int
executionTime :: Prelude.Maybe Prelude.Int,
    -- | The date and time when this task run was last modified.
    GetMLTaskRunResponse -> Maybe POSIX
lastModifiedOn :: Prelude.Maybe Data.POSIX,
    -- | The names of the log groups that are associated with the task run.
    GetMLTaskRunResponse -> Maybe Text
logGroupName :: Prelude.Maybe Prelude.Text,
    -- | The list of properties that are associated with the task run.
    GetMLTaskRunResponse -> Maybe TaskRunProperties
properties :: Prelude.Maybe TaskRunProperties,
    -- | The date and time when this task run started.
    GetMLTaskRunResponse -> Maybe POSIX
startedOn :: Prelude.Maybe Data.POSIX,
    -- | The status for this task run.
    GetMLTaskRunResponse -> Maybe TaskStatusType
status :: Prelude.Maybe TaskStatusType,
    -- | The unique run identifier associated with this run.
    GetMLTaskRunResponse -> Maybe Text
taskRunId :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier of the task run.
    GetMLTaskRunResponse -> Maybe Text
transformId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetMLTaskRunResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetMLTaskRunResponse -> GetMLTaskRunResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetMLTaskRunResponse -> GetMLTaskRunResponse -> Bool
$c/= :: GetMLTaskRunResponse -> GetMLTaskRunResponse -> Bool
== :: GetMLTaskRunResponse -> GetMLTaskRunResponse -> Bool
$c== :: GetMLTaskRunResponse -> GetMLTaskRunResponse -> Bool
Prelude.Eq, ReadPrec [GetMLTaskRunResponse]
ReadPrec GetMLTaskRunResponse
Int -> ReadS GetMLTaskRunResponse
ReadS [GetMLTaskRunResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetMLTaskRunResponse]
$creadListPrec :: ReadPrec [GetMLTaskRunResponse]
readPrec :: ReadPrec GetMLTaskRunResponse
$creadPrec :: ReadPrec GetMLTaskRunResponse
readList :: ReadS [GetMLTaskRunResponse]
$creadList :: ReadS [GetMLTaskRunResponse]
readsPrec :: Int -> ReadS GetMLTaskRunResponse
$creadsPrec :: Int -> ReadS GetMLTaskRunResponse
Prelude.Read, Int -> GetMLTaskRunResponse -> ShowS
[GetMLTaskRunResponse] -> ShowS
GetMLTaskRunResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetMLTaskRunResponse] -> ShowS
$cshowList :: [GetMLTaskRunResponse] -> ShowS
show :: GetMLTaskRunResponse -> String
$cshow :: GetMLTaskRunResponse -> String
showsPrec :: Int -> GetMLTaskRunResponse -> ShowS
$cshowsPrec :: Int -> GetMLTaskRunResponse -> ShowS
Prelude.Show, forall x. Rep GetMLTaskRunResponse x -> GetMLTaskRunResponse
forall x. GetMLTaskRunResponse -> Rep GetMLTaskRunResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetMLTaskRunResponse x -> GetMLTaskRunResponse
$cfrom :: forall x. GetMLTaskRunResponse -> Rep GetMLTaskRunResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetMLTaskRunResponse' 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:
--
-- 'completedOn', 'getMLTaskRunResponse_completedOn' - The date and time when this task run was completed.
--
-- 'errorString', 'getMLTaskRunResponse_errorString' - The error strings that are associated with the task run.
--
-- 'executionTime', 'getMLTaskRunResponse_executionTime' - The amount of time (in seconds) that the task run consumed resources.
--
-- 'lastModifiedOn', 'getMLTaskRunResponse_lastModifiedOn' - The date and time when this task run was last modified.
--
-- 'logGroupName', 'getMLTaskRunResponse_logGroupName' - The names of the log groups that are associated with the task run.
--
-- 'properties', 'getMLTaskRunResponse_properties' - The list of properties that are associated with the task run.
--
-- 'startedOn', 'getMLTaskRunResponse_startedOn' - The date and time when this task run started.
--
-- 'status', 'getMLTaskRunResponse_status' - The status for this task run.
--
-- 'taskRunId', 'getMLTaskRunResponse_taskRunId' - The unique run identifier associated with this run.
--
-- 'transformId', 'getMLTaskRunResponse_transformId' - The unique identifier of the task run.
--
-- 'httpStatus', 'getMLTaskRunResponse_httpStatus' - The response's http status code.
newGetMLTaskRunResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetMLTaskRunResponse
newGetMLTaskRunResponse :: Int -> GetMLTaskRunResponse
newGetMLTaskRunResponse Int
pHttpStatus_ =
  GetMLTaskRunResponse'
    { $sel:completedOn:GetMLTaskRunResponse' :: Maybe POSIX
completedOn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:errorString:GetMLTaskRunResponse' :: Maybe Text
errorString = forall a. Maybe a
Prelude.Nothing,
      $sel:executionTime:GetMLTaskRunResponse' :: Maybe Int
executionTime = forall a. Maybe a
Prelude.Nothing,
      $sel:lastModifiedOn:GetMLTaskRunResponse' :: Maybe POSIX
lastModifiedOn = forall a. Maybe a
Prelude.Nothing,
      $sel:logGroupName:GetMLTaskRunResponse' :: Maybe Text
logGroupName = forall a. Maybe a
Prelude.Nothing,
      $sel:properties:GetMLTaskRunResponse' :: Maybe TaskRunProperties
properties = forall a. Maybe a
Prelude.Nothing,
      $sel:startedOn:GetMLTaskRunResponse' :: Maybe POSIX
startedOn = forall a. Maybe a
Prelude.Nothing,
      $sel:status:GetMLTaskRunResponse' :: Maybe TaskStatusType
status = forall a. Maybe a
Prelude.Nothing,
      $sel:taskRunId:GetMLTaskRunResponse' :: Maybe Text
taskRunId = forall a. Maybe a
Prelude.Nothing,
      $sel:transformId:GetMLTaskRunResponse' :: Maybe Text
transformId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetMLTaskRunResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The date and time when this task run was completed.
getMLTaskRunResponse_completedOn :: Lens.Lens' GetMLTaskRunResponse (Prelude.Maybe Prelude.UTCTime)
getMLTaskRunResponse_completedOn :: Lens' GetMLTaskRunResponse (Maybe UTCTime)
getMLTaskRunResponse_completedOn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLTaskRunResponse' {Maybe POSIX
completedOn :: Maybe POSIX
$sel:completedOn:GetMLTaskRunResponse' :: GetMLTaskRunResponse -> Maybe POSIX
completedOn} -> Maybe POSIX
completedOn) (\s :: GetMLTaskRunResponse
s@GetMLTaskRunResponse' {} Maybe POSIX
a -> GetMLTaskRunResponse
s {$sel:completedOn:GetMLTaskRunResponse' :: Maybe POSIX
completedOn = Maybe POSIX
a} :: GetMLTaskRunResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The error strings that are associated with the task run.
getMLTaskRunResponse_errorString :: Lens.Lens' GetMLTaskRunResponse (Prelude.Maybe Prelude.Text)
getMLTaskRunResponse_errorString :: Lens' GetMLTaskRunResponse (Maybe Text)
getMLTaskRunResponse_errorString = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLTaskRunResponse' {Maybe Text
errorString :: Maybe Text
$sel:errorString:GetMLTaskRunResponse' :: GetMLTaskRunResponse -> Maybe Text
errorString} -> Maybe Text
errorString) (\s :: GetMLTaskRunResponse
s@GetMLTaskRunResponse' {} Maybe Text
a -> GetMLTaskRunResponse
s {$sel:errorString:GetMLTaskRunResponse' :: Maybe Text
errorString = Maybe Text
a} :: GetMLTaskRunResponse)

-- | The amount of time (in seconds) that the task run consumed resources.
getMLTaskRunResponse_executionTime :: Lens.Lens' GetMLTaskRunResponse (Prelude.Maybe Prelude.Int)
getMLTaskRunResponse_executionTime :: Lens' GetMLTaskRunResponse (Maybe Int)
getMLTaskRunResponse_executionTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLTaskRunResponse' {Maybe Int
executionTime :: Maybe Int
$sel:executionTime:GetMLTaskRunResponse' :: GetMLTaskRunResponse -> Maybe Int
executionTime} -> Maybe Int
executionTime) (\s :: GetMLTaskRunResponse
s@GetMLTaskRunResponse' {} Maybe Int
a -> GetMLTaskRunResponse
s {$sel:executionTime:GetMLTaskRunResponse' :: Maybe Int
executionTime = Maybe Int
a} :: GetMLTaskRunResponse)

-- | The date and time when this task run was last modified.
getMLTaskRunResponse_lastModifiedOn :: Lens.Lens' GetMLTaskRunResponse (Prelude.Maybe Prelude.UTCTime)
getMLTaskRunResponse_lastModifiedOn :: Lens' GetMLTaskRunResponse (Maybe UTCTime)
getMLTaskRunResponse_lastModifiedOn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLTaskRunResponse' {Maybe POSIX
lastModifiedOn :: Maybe POSIX
$sel:lastModifiedOn:GetMLTaskRunResponse' :: GetMLTaskRunResponse -> Maybe POSIX
lastModifiedOn} -> Maybe POSIX
lastModifiedOn) (\s :: GetMLTaskRunResponse
s@GetMLTaskRunResponse' {} Maybe POSIX
a -> GetMLTaskRunResponse
s {$sel:lastModifiedOn:GetMLTaskRunResponse' :: Maybe POSIX
lastModifiedOn = Maybe POSIX
a} :: GetMLTaskRunResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The names of the log groups that are associated with the task run.
getMLTaskRunResponse_logGroupName :: Lens.Lens' GetMLTaskRunResponse (Prelude.Maybe Prelude.Text)
getMLTaskRunResponse_logGroupName :: Lens' GetMLTaskRunResponse (Maybe Text)
getMLTaskRunResponse_logGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLTaskRunResponse' {Maybe Text
logGroupName :: Maybe Text
$sel:logGroupName:GetMLTaskRunResponse' :: GetMLTaskRunResponse -> Maybe Text
logGroupName} -> Maybe Text
logGroupName) (\s :: GetMLTaskRunResponse
s@GetMLTaskRunResponse' {} Maybe Text
a -> GetMLTaskRunResponse
s {$sel:logGroupName:GetMLTaskRunResponse' :: Maybe Text
logGroupName = Maybe Text
a} :: GetMLTaskRunResponse)

-- | The list of properties that are associated with the task run.
getMLTaskRunResponse_properties :: Lens.Lens' GetMLTaskRunResponse (Prelude.Maybe TaskRunProperties)
getMLTaskRunResponse_properties :: Lens' GetMLTaskRunResponse (Maybe TaskRunProperties)
getMLTaskRunResponse_properties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLTaskRunResponse' {Maybe TaskRunProperties
properties :: Maybe TaskRunProperties
$sel:properties:GetMLTaskRunResponse' :: GetMLTaskRunResponse -> Maybe TaskRunProperties
properties} -> Maybe TaskRunProperties
properties) (\s :: GetMLTaskRunResponse
s@GetMLTaskRunResponse' {} Maybe TaskRunProperties
a -> GetMLTaskRunResponse
s {$sel:properties:GetMLTaskRunResponse' :: Maybe TaskRunProperties
properties = Maybe TaskRunProperties
a} :: GetMLTaskRunResponse)

-- | The date and time when this task run started.
getMLTaskRunResponse_startedOn :: Lens.Lens' GetMLTaskRunResponse (Prelude.Maybe Prelude.UTCTime)
getMLTaskRunResponse_startedOn :: Lens' GetMLTaskRunResponse (Maybe UTCTime)
getMLTaskRunResponse_startedOn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLTaskRunResponse' {Maybe POSIX
startedOn :: Maybe POSIX
$sel:startedOn:GetMLTaskRunResponse' :: GetMLTaskRunResponse -> Maybe POSIX
startedOn} -> Maybe POSIX
startedOn) (\s :: GetMLTaskRunResponse
s@GetMLTaskRunResponse' {} Maybe POSIX
a -> GetMLTaskRunResponse
s {$sel:startedOn:GetMLTaskRunResponse' :: Maybe POSIX
startedOn = Maybe POSIX
a} :: GetMLTaskRunResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The status for this task run.
getMLTaskRunResponse_status :: Lens.Lens' GetMLTaskRunResponse (Prelude.Maybe TaskStatusType)
getMLTaskRunResponse_status :: Lens' GetMLTaskRunResponse (Maybe TaskStatusType)
getMLTaskRunResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLTaskRunResponse' {Maybe TaskStatusType
status :: Maybe TaskStatusType
$sel:status:GetMLTaskRunResponse' :: GetMLTaskRunResponse -> Maybe TaskStatusType
status} -> Maybe TaskStatusType
status) (\s :: GetMLTaskRunResponse
s@GetMLTaskRunResponse' {} Maybe TaskStatusType
a -> GetMLTaskRunResponse
s {$sel:status:GetMLTaskRunResponse' :: Maybe TaskStatusType
status = Maybe TaskStatusType
a} :: GetMLTaskRunResponse)

-- | The unique run identifier associated with this run.
getMLTaskRunResponse_taskRunId :: Lens.Lens' GetMLTaskRunResponse (Prelude.Maybe Prelude.Text)
getMLTaskRunResponse_taskRunId :: Lens' GetMLTaskRunResponse (Maybe Text)
getMLTaskRunResponse_taskRunId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLTaskRunResponse' {Maybe Text
taskRunId :: Maybe Text
$sel:taskRunId:GetMLTaskRunResponse' :: GetMLTaskRunResponse -> Maybe Text
taskRunId} -> Maybe Text
taskRunId) (\s :: GetMLTaskRunResponse
s@GetMLTaskRunResponse' {} Maybe Text
a -> GetMLTaskRunResponse
s {$sel:taskRunId:GetMLTaskRunResponse' :: Maybe Text
taskRunId = Maybe Text
a} :: GetMLTaskRunResponse)

-- | The unique identifier of the task run.
getMLTaskRunResponse_transformId :: Lens.Lens' GetMLTaskRunResponse (Prelude.Maybe Prelude.Text)
getMLTaskRunResponse_transformId :: Lens' GetMLTaskRunResponse (Maybe Text)
getMLTaskRunResponse_transformId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMLTaskRunResponse' {Maybe Text
transformId :: Maybe Text
$sel:transformId:GetMLTaskRunResponse' :: GetMLTaskRunResponse -> Maybe Text
transformId} -> Maybe Text
transformId) (\s :: GetMLTaskRunResponse
s@GetMLTaskRunResponse' {} Maybe Text
a -> GetMLTaskRunResponse
s {$sel:transformId:GetMLTaskRunResponse' :: Maybe Text
transformId = Maybe Text
a} :: GetMLTaskRunResponse)

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

instance Prelude.NFData GetMLTaskRunResponse where
  rnf :: GetMLTaskRunResponse -> ()
rnf GetMLTaskRunResponse' {Int
Maybe Int
Maybe Text
Maybe POSIX
Maybe TaskStatusType
Maybe TaskRunProperties
httpStatus :: Int
transformId :: Maybe Text
taskRunId :: Maybe Text
status :: Maybe TaskStatusType
startedOn :: Maybe POSIX
properties :: Maybe TaskRunProperties
logGroupName :: Maybe Text
lastModifiedOn :: Maybe POSIX
executionTime :: Maybe Int
errorString :: Maybe Text
completedOn :: Maybe POSIX
$sel:httpStatus:GetMLTaskRunResponse' :: GetMLTaskRunResponse -> Int
$sel:transformId:GetMLTaskRunResponse' :: GetMLTaskRunResponse -> Maybe Text
$sel:taskRunId:GetMLTaskRunResponse' :: GetMLTaskRunResponse -> Maybe Text
$sel:status:GetMLTaskRunResponse' :: GetMLTaskRunResponse -> Maybe TaskStatusType
$sel:startedOn:GetMLTaskRunResponse' :: GetMLTaskRunResponse -> Maybe POSIX
$sel:properties:GetMLTaskRunResponse' :: GetMLTaskRunResponse -> Maybe TaskRunProperties
$sel:logGroupName:GetMLTaskRunResponse' :: GetMLTaskRunResponse -> Maybe Text
$sel:lastModifiedOn:GetMLTaskRunResponse' :: GetMLTaskRunResponse -> Maybe POSIX
$sel:executionTime:GetMLTaskRunResponse' :: GetMLTaskRunResponse -> Maybe Int
$sel:errorString:GetMLTaskRunResponse' :: GetMLTaskRunResponse -> Maybe Text
$sel:completedOn:GetMLTaskRunResponse' :: GetMLTaskRunResponse -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
completedOn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
errorString
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
executionTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastModifiedOn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
logGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TaskRunProperties
properties
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
startedOn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TaskStatusType
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
taskRunId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
transformId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus