{-# 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.StartMLLabelingSetGenerationTaskRun
-- 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 the active learning workflow for your machine learning transform
-- to improve the transform\'s quality by generating label sets and adding
-- labels.
--
-- When the @StartMLLabelingSetGenerationTaskRun@ finishes, Glue will have
-- generated a \"labeling set\" or a set of questions for humans to answer.
--
-- In the case of the @FindMatches@ transform, these questions are of the
-- form, “What is the correct way to group these rows together into groups
-- composed entirely of matching records?”
--
-- After the labeling process is finished, you can upload your labels with
-- a call to @StartImportLabelsTaskRun@. After @StartImportLabelsTaskRun@
-- finishes, all future runs of the machine learning transform will use the
-- new and improved labels and perform a higher-quality transformation.
module Amazonka.Glue.StartMLLabelingSetGenerationTaskRun
  ( -- * Creating a Request
    StartMLLabelingSetGenerationTaskRun (..),
    newStartMLLabelingSetGenerationTaskRun,

    -- * Request Lenses
    startMLLabelingSetGenerationTaskRun_transformId,
    startMLLabelingSetGenerationTaskRun_outputS3Path,

    -- * Destructuring the Response
    StartMLLabelingSetGenerationTaskRunResponse (..),
    newStartMLLabelingSetGenerationTaskRunResponse,

    -- * Response Lenses
    startMLLabelingSetGenerationTaskRunResponse_taskRunId,
    startMLLabelingSetGenerationTaskRunResponse_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:/ 'newStartMLLabelingSetGenerationTaskRun' smart constructor.
data StartMLLabelingSetGenerationTaskRun = StartMLLabelingSetGenerationTaskRun'
  { -- | The unique identifier of the machine learning transform.
    StartMLLabelingSetGenerationTaskRun -> Text
transformId :: Prelude.Text,
    -- | The Amazon Simple Storage Service (Amazon S3) path where you generate
    -- the labeling set.
    StartMLLabelingSetGenerationTaskRun -> Text
outputS3Path :: Prelude.Text
  }
  deriving (StartMLLabelingSetGenerationTaskRun
-> StartMLLabelingSetGenerationTaskRun -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartMLLabelingSetGenerationTaskRun
-> StartMLLabelingSetGenerationTaskRun -> Bool
$c/= :: StartMLLabelingSetGenerationTaskRun
-> StartMLLabelingSetGenerationTaskRun -> Bool
== :: StartMLLabelingSetGenerationTaskRun
-> StartMLLabelingSetGenerationTaskRun -> Bool
$c== :: StartMLLabelingSetGenerationTaskRun
-> StartMLLabelingSetGenerationTaskRun -> Bool
Prelude.Eq, ReadPrec [StartMLLabelingSetGenerationTaskRun]
ReadPrec StartMLLabelingSetGenerationTaskRun
Int -> ReadS StartMLLabelingSetGenerationTaskRun
ReadS [StartMLLabelingSetGenerationTaskRun]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartMLLabelingSetGenerationTaskRun]
$creadListPrec :: ReadPrec [StartMLLabelingSetGenerationTaskRun]
readPrec :: ReadPrec StartMLLabelingSetGenerationTaskRun
$creadPrec :: ReadPrec StartMLLabelingSetGenerationTaskRun
readList :: ReadS [StartMLLabelingSetGenerationTaskRun]
$creadList :: ReadS [StartMLLabelingSetGenerationTaskRun]
readsPrec :: Int -> ReadS StartMLLabelingSetGenerationTaskRun
$creadsPrec :: Int -> ReadS StartMLLabelingSetGenerationTaskRun
Prelude.Read, Int -> StartMLLabelingSetGenerationTaskRun -> ShowS
[StartMLLabelingSetGenerationTaskRun] -> ShowS
StartMLLabelingSetGenerationTaskRun -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartMLLabelingSetGenerationTaskRun] -> ShowS
$cshowList :: [StartMLLabelingSetGenerationTaskRun] -> ShowS
show :: StartMLLabelingSetGenerationTaskRun -> String
$cshow :: StartMLLabelingSetGenerationTaskRun -> String
showsPrec :: Int -> StartMLLabelingSetGenerationTaskRun -> ShowS
$cshowsPrec :: Int -> StartMLLabelingSetGenerationTaskRun -> ShowS
Prelude.Show, forall x.
Rep StartMLLabelingSetGenerationTaskRun x
-> StartMLLabelingSetGenerationTaskRun
forall x.
StartMLLabelingSetGenerationTaskRun
-> Rep StartMLLabelingSetGenerationTaskRun x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartMLLabelingSetGenerationTaskRun x
-> StartMLLabelingSetGenerationTaskRun
$cfrom :: forall x.
StartMLLabelingSetGenerationTaskRun
-> Rep StartMLLabelingSetGenerationTaskRun x
Prelude.Generic)

-- |
-- Create a value of 'StartMLLabelingSetGenerationTaskRun' 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', 'startMLLabelingSetGenerationTaskRun_transformId' - The unique identifier of the machine learning transform.
--
-- 'outputS3Path', 'startMLLabelingSetGenerationTaskRun_outputS3Path' - The Amazon Simple Storage Service (Amazon S3) path where you generate
-- the labeling set.
newStartMLLabelingSetGenerationTaskRun ::
  -- | 'transformId'
  Prelude.Text ->
  -- | 'outputS3Path'
  Prelude.Text ->
  StartMLLabelingSetGenerationTaskRun
newStartMLLabelingSetGenerationTaskRun :: Text -> Text -> StartMLLabelingSetGenerationTaskRun
newStartMLLabelingSetGenerationTaskRun
  Text
pTransformId_
  Text
pOutputS3Path_ =
    StartMLLabelingSetGenerationTaskRun'
      { $sel:transformId:StartMLLabelingSetGenerationTaskRun' :: Text
transformId =
          Text
pTransformId_,
        $sel:outputS3Path:StartMLLabelingSetGenerationTaskRun' :: Text
outputS3Path = Text
pOutputS3Path_
      }

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

-- | The Amazon Simple Storage Service (Amazon S3) path where you generate
-- the labeling set.
startMLLabelingSetGenerationTaskRun_outputS3Path :: Lens.Lens' StartMLLabelingSetGenerationTaskRun Prelude.Text
startMLLabelingSetGenerationTaskRun_outputS3Path :: Lens' StartMLLabelingSetGenerationTaskRun Text
startMLLabelingSetGenerationTaskRun_outputS3Path = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartMLLabelingSetGenerationTaskRun' {Text
outputS3Path :: Text
$sel:outputS3Path:StartMLLabelingSetGenerationTaskRun' :: StartMLLabelingSetGenerationTaskRun -> Text
outputS3Path} -> Text
outputS3Path) (\s :: StartMLLabelingSetGenerationTaskRun
s@StartMLLabelingSetGenerationTaskRun' {} Text
a -> StartMLLabelingSetGenerationTaskRun
s {$sel:outputS3Path:StartMLLabelingSetGenerationTaskRun' :: Text
outputS3Path = Text
a} :: StartMLLabelingSetGenerationTaskRun)

instance
  Core.AWSRequest
    StartMLLabelingSetGenerationTaskRun
  where
  type
    AWSResponse StartMLLabelingSetGenerationTaskRun =
      StartMLLabelingSetGenerationTaskRunResponse
  request :: (Service -> Service)
-> StartMLLabelingSetGenerationTaskRun
-> Request StartMLLabelingSetGenerationTaskRun
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 StartMLLabelingSetGenerationTaskRun
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse StartMLLabelingSetGenerationTaskRun)))
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 Text -> Int -> StartMLLabelingSetGenerationTaskRunResponse
StartMLLabelingSetGenerationTaskRunResponse'
            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
"TaskRunId")
            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
    StartMLLabelingSetGenerationTaskRun
  where
  hashWithSalt :: Int -> StartMLLabelingSetGenerationTaskRun -> Int
hashWithSalt
    Int
_salt
    StartMLLabelingSetGenerationTaskRun' {Text
outputS3Path :: Text
transformId :: Text
$sel:outputS3Path:StartMLLabelingSetGenerationTaskRun' :: StartMLLabelingSetGenerationTaskRun -> Text
$sel:transformId:StartMLLabelingSetGenerationTaskRun' :: StartMLLabelingSetGenerationTaskRun -> Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
transformId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
outputS3Path

instance
  Prelude.NFData
    StartMLLabelingSetGenerationTaskRun
  where
  rnf :: StartMLLabelingSetGenerationTaskRun -> ()
rnf StartMLLabelingSetGenerationTaskRun' {Text
outputS3Path :: Text
transformId :: Text
$sel:outputS3Path:StartMLLabelingSetGenerationTaskRun' :: StartMLLabelingSetGenerationTaskRun -> Text
$sel:transformId:StartMLLabelingSetGenerationTaskRun' :: StartMLLabelingSetGenerationTaskRun -> 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
outputS3Path

instance
  Data.ToHeaders
    StartMLLabelingSetGenerationTaskRun
  where
  toHeaders :: StartMLLabelingSetGenerationTaskRun -> 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.StartMLLabelingSetGenerationTaskRun" ::
                          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
    StartMLLabelingSetGenerationTaskRun
  where
  toJSON :: StartMLLabelingSetGenerationTaskRun -> Value
toJSON StartMLLabelingSetGenerationTaskRun' {Text
outputS3Path :: Text
transformId :: Text
$sel:outputS3Path:StartMLLabelingSetGenerationTaskRun' :: StartMLLabelingSetGenerationTaskRun -> Text
$sel:transformId:StartMLLabelingSetGenerationTaskRun' :: StartMLLabelingSetGenerationTaskRun -> 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
"OutputS3Path" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
outputS3Path)
          ]
      )

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

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

-- | /See:/ 'newStartMLLabelingSetGenerationTaskRunResponse' smart constructor.
data StartMLLabelingSetGenerationTaskRunResponse = StartMLLabelingSetGenerationTaskRunResponse'
  { -- | The unique run identifier that is associated with this task run.
    StartMLLabelingSetGenerationTaskRunResponse -> Maybe Text
taskRunId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    StartMLLabelingSetGenerationTaskRunResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StartMLLabelingSetGenerationTaskRunResponse
-> StartMLLabelingSetGenerationTaskRunResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartMLLabelingSetGenerationTaskRunResponse
-> StartMLLabelingSetGenerationTaskRunResponse -> Bool
$c/= :: StartMLLabelingSetGenerationTaskRunResponse
-> StartMLLabelingSetGenerationTaskRunResponse -> Bool
== :: StartMLLabelingSetGenerationTaskRunResponse
-> StartMLLabelingSetGenerationTaskRunResponse -> Bool
$c== :: StartMLLabelingSetGenerationTaskRunResponse
-> StartMLLabelingSetGenerationTaskRunResponse -> Bool
Prelude.Eq, ReadPrec [StartMLLabelingSetGenerationTaskRunResponse]
ReadPrec StartMLLabelingSetGenerationTaskRunResponse
Int -> ReadS StartMLLabelingSetGenerationTaskRunResponse
ReadS [StartMLLabelingSetGenerationTaskRunResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartMLLabelingSetGenerationTaskRunResponse]
$creadListPrec :: ReadPrec [StartMLLabelingSetGenerationTaskRunResponse]
readPrec :: ReadPrec StartMLLabelingSetGenerationTaskRunResponse
$creadPrec :: ReadPrec StartMLLabelingSetGenerationTaskRunResponse
readList :: ReadS [StartMLLabelingSetGenerationTaskRunResponse]
$creadList :: ReadS [StartMLLabelingSetGenerationTaskRunResponse]
readsPrec :: Int -> ReadS StartMLLabelingSetGenerationTaskRunResponse
$creadsPrec :: Int -> ReadS StartMLLabelingSetGenerationTaskRunResponse
Prelude.Read, Int -> StartMLLabelingSetGenerationTaskRunResponse -> ShowS
[StartMLLabelingSetGenerationTaskRunResponse] -> ShowS
StartMLLabelingSetGenerationTaskRunResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartMLLabelingSetGenerationTaskRunResponse] -> ShowS
$cshowList :: [StartMLLabelingSetGenerationTaskRunResponse] -> ShowS
show :: StartMLLabelingSetGenerationTaskRunResponse -> String
$cshow :: StartMLLabelingSetGenerationTaskRunResponse -> String
showsPrec :: Int -> StartMLLabelingSetGenerationTaskRunResponse -> ShowS
$cshowsPrec :: Int -> StartMLLabelingSetGenerationTaskRunResponse -> ShowS
Prelude.Show, forall x.
Rep StartMLLabelingSetGenerationTaskRunResponse x
-> StartMLLabelingSetGenerationTaskRunResponse
forall x.
StartMLLabelingSetGenerationTaskRunResponse
-> Rep StartMLLabelingSetGenerationTaskRunResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartMLLabelingSetGenerationTaskRunResponse x
-> StartMLLabelingSetGenerationTaskRunResponse
$cfrom :: forall x.
StartMLLabelingSetGenerationTaskRunResponse
-> Rep StartMLLabelingSetGenerationTaskRunResponse x
Prelude.Generic)

-- |
-- Create a value of 'StartMLLabelingSetGenerationTaskRunResponse' 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:
--
-- 'taskRunId', 'startMLLabelingSetGenerationTaskRunResponse_taskRunId' - The unique run identifier that is associated with this task run.
--
-- 'httpStatus', 'startMLLabelingSetGenerationTaskRunResponse_httpStatus' - The response's http status code.
newStartMLLabelingSetGenerationTaskRunResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartMLLabelingSetGenerationTaskRunResponse
newStartMLLabelingSetGenerationTaskRunResponse :: Int -> StartMLLabelingSetGenerationTaskRunResponse
newStartMLLabelingSetGenerationTaskRunResponse
  Int
pHttpStatus_ =
    StartMLLabelingSetGenerationTaskRunResponse'
      { $sel:taskRunId:StartMLLabelingSetGenerationTaskRunResponse' :: Maybe Text
taskRunId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:StartMLLabelingSetGenerationTaskRunResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

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

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

instance
  Prelude.NFData
    StartMLLabelingSetGenerationTaskRunResponse
  where
  rnf :: StartMLLabelingSetGenerationTaskRunResponse -> ()
rnf StartMLLabelingSetGenerationTaskRunResponse' {Int
Maybe Text
httpStatus :: Int
taskRunId :: Maybe Text
$sel:httpStatus:StartMLLabelingSetGenerationTaskRunResponse' :: StartMLLabelingSetGenerationTaskRunResponse -> Int
$sel:taskRunId:StartMLLabelingSetGenerationTaskRunResponse' :: StartMLLabelingSetGenerationTaskRunResponse -> Maybe Text
..} =
    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 Int
httpStatus