{-# 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.StartImportLabelsTaskRun
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Enables you to provide additional labels (examples of truth) to be used
-- to teach the machine learning transform and improve its quality. This
-- API operation is generally used as part of the active learning workflow
-- that starts with the @StartMLLabelingSetGenerationTaskRun@ call and that
-- ultimately results in improving the quality of your machine learning
-- transform.
--
-- After the @StartMLLabelingSetGenerationTaskRun@ finishes, Glue machine
-- learning will have generated a series of questions for humans to answer.
-- (Answering these questions is often called \'labeling\' in the machine
-- learning workflows). 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, users upload their answers\/labels with a
-- call to @StartImportLabelsTaskRun@. After @StartImportLabelsTaskRun@
-- finishes, all future runs of the machine learning transform use the new
-- and improved labels and perform a higher-quality transformation.
--
-- By default, @StartMLLabelingSetGenerationTaskRun@ continually learns
-- from and combines all labels that you upload unless you set @Replace@ to
-- true. If you set @Replace@ to true, @StartImportLabelsTaskRun@ deletes
-- and forgets all previously uploaded labels and learns only from the
-- exact set that you upload. Replacing labels can be helpful if you
-- realize that you previously uploaded incorrect labels, and you believe
-- that they are having a negative effect on your transform quality.
--
-- You can check on the status of your task run by calling the
-- @GetMLTaskRun@ operation.
module Amazonka.Glue.StartImportLabelsTaskRun
  ( -- * Creating a Request
    StartImportLabelsTaskRun (..),
    newStartImportLabelsTaskRun,

    -- * Request Lenses
    startImportLabelsTaskRun_replaceAllLabels,
    startImportLabelsTaskRun_transformId,
    startImportLabelsTaskRun_inputS3Path,

    -- * Destructuring the Response
    StartImportLabelsTaskRunResponse (..),
    newStartImportLabelsTaskRunResponse,

    -- * Response Lenses
    startImportLabelsTaskRunResponse_taskRunId,
    startImportLabelsTaskRunResponse_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:/ 'newStartImportLabelsTaskRun' smart constructor.
data StartImportLabelsTaskRun = StartImportLabelsTaskRun'
  { -- | Indicates whether to overwrite your existing labels.
    StartImportLabelsTaskRun -> Maybe Bool
replaceAllLabels :: Prelude.Maybe Prelude.Bool,
    -- | The unique identifier of the machine learning transform.
    StartImportLabelsTaskRun -> Text
transformId :: Prelude.Text,
    -- | The Amazon Simple Storage Service (Amazon S3) path from where you import
    -- the labels.
    StartImportLabelsTaskRun -> Text
inputS3Path :: Prelude.Text
  }
  deriving (StartImportLabelsTaskRun -> StartImportLabelsTaskRun -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartImportLabelsTaskRun -> StartImportLabelsTaskRun -> Bool
$c/= :: StartImportLabelsTaskRun -> StartImportLabelsTaskRun -> Bool
== :: StartImportLabelsTaskRun -> StartImportLabelsTaskRun -> Bool
$c== :: StartImportLabelsTaskRun -> StartImportLabelsTaskRun -> Bool
Prelude.Eq, ReadPrec [StartImportLabelsTaskRun]
ReadPrec StartImportLabelsTaskRun
Int -> ReadS StartImportLabelsTaskRun
ReadS [StartImportLabelsTaskRun]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartImportLabelsTaskRun]
$creadListPrec :: ReadPrec [StartImportLabelsTaskRun]
readPrec :: ReadPrec StartImportLabelsTaskRun
$creadPrec :: ReadPrec StartImportLabelsTaskRun
readList :: ReadS [StartImportLabelsTaskRun]
$creadList :: ReadS [StartImportLabelsTaskRun]
readsPrec :: Int -> ReadS StartImportLabelsTaskRun
$creadsPrec :: Int -> ReadS StartImportLabelsTaskRun
Prelude.Read, Int -> StartImportLabelsTaskRun -> ShowS
[StartImportLabelsTaskRun] -> ShowS
StartImportLabelsTaskRun -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartImportLabelsTaskRun] -> ShowS
$cshowList :: [StartImportLabelsTaskRun] -> ShowS
show :: StartImportLabelsTaskRun -> String
$cshow :: StartImportLabelsTaskRun -> String
showsPrec :: Int -> StartImportLabelsTaskRun -> ShowS
$cshowsPrec :: Int -> StartImportLabelsTaskRun -> ShowS
Prelude.Show, forall x.
Rep StartImportLabelsTaskRun x -> StartImportLabelsTaskRun
forall x.
StartImportLabelsTaskRun -> Rep StartImportLabelsTaskRun x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartImportLabelsTaskRun x -> StartImportLabelsTaskRun
$cfrom :: forall x.
StartImportLabelsTaskRun -> Rep StartImportLabelsTaskRun x
Prelude.Generic)

-- |
-- Create a value of 'StartImportLabelsTaskRun' 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:
--
-- 'replaceAllLabels', 'startImportLabelsTaskRun_replaceAllLabels' - Indicates whether to overwrite your existing labels.
--
-- 'transformId', 'startImportLabelsTaskRun_transformId' - The unique identifier of the machine learning transform.
--
-- 'inputS3Path', 'startImportLabelsTaskRun_inputS3Path' - The Amazon Simple Storage Service (Amazon S3) path from where you import
-- the labels.
newStartImportLabelsTaskRun ::
  -- | 'transformId'
  Prelude.Text ->
  -- | 'inputS3Path'
  Prelude.Text ->
  StartImportLabelsTaskRun
newStartImportLabelsTaskRun :: Text -> Text -> StartImportLabelsTaskRun
newStartImportLabelsTaskRun
  Text
pTransformId_
  Text
pInputS3Path_ =
    StartImportLabelsTaskRun'
      { $sel:replaceAllLabels:StartImportLabelsTaskRun' :: Maybe Bool
replaceAllLabels =
          forall a. Maybe a
Prelude.Nothing,
        $sel:transformId:StartImportLabelsTaskRun' :: Text
transformId = Text
pTransformId_,
        $sel:inputS3Path:StartImportLabelsTaskRun' :: Text
inputS3Path = Text
pInputS3Path_
      }

-- | Indicates whether to overwrite your existing labels.
startImportLabelsTaskRun_replaceAllLabels :: Lens.Lens' StartImportLabelsTaskRun (Prelude.Maybe Prelude.Bool)
startImportLabelsTaskRun_replaceAllLabels :: Lens' StartImportLabelsTaskRun (Maybe Bool)
startImportLabelsTaskRun_replaceAllLabels = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartImportLabelsTaskRun' {Maybe Bool
replaceAllLabels :: Maybe Bool
$sel:replaceAllLabels:StartImportLabelsTaskRun' :: StartImportLabelsTaskRun -> Maybe Bool
replaceAllLabels} -> Maybe Bool
replaceAllLabels) (\s :: StartImportLabelsTaskRun
s@StartImportLabelsTaskRun' {} Maybe Bool
a -> StartImportLabelsTaskRun
s {$sel:replaceAllLabels:StartImportLabelsTaskRun' :: Maybe Bool
replaceAllLabels = Maybe Bool
a} :: StartImportLabelsTaskRun)

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

-- | The Amazon Simple Storage Service (Amazon S3) path from where you import
-- the labels.
startImportLabelsTaskRun_inputS3Path :: Lens.Lens' StartImportLabelsTaskRun Prelude.Text
startImportLabelsTaskRun_inputS3Path :: Lens' StartImportLabelsTaskRun Text
startImportLabelsTaskRun_inputS3Path = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartImportLabelsTaskRun' {Text
inputS3Path :: Text
$sel:inputS3Path:StartImportLabelsTaskRun' :: StartImportLabelsTaskRun -> Text
inputS3Path} -> Text
inputS3Path) (\s :: StartImportLabelsTaskRun
s@StartImportLabelsTaskRun' {} Text
a -> StartImportLabelsTaskRun
s {$sel:inputS3Path:StartImportLabelsTaskRun' :: Text
inputS3Path = Text
a} :: StartImportLabelsTaskRun)

instance Core.AWSRequest StartImportLabelsTaskRun where
  type
    AWSResponse StartImportLabelsTaskRun =
      StartImportLabelsTaskRunResponse
  request :: (Service -> Service)
-> StartImportLabelsTaskRun -> Request StartImportLabelsTaskRun
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 StartImportLabelsTaskRun
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartImportLabelsTaskRun)))
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 -> StartImportLabelsTaskRunResponse
StartImportLabelsTaskRunResponse'
            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 StartImportLabelsTaskRun where
  hashWithSalt :: Int -> StartImportLabelsTaskRun -> Int
hashWithSalt Int
_salt StartImportLabelsTaskRun' {Maybe Bool
Text
inputS3Path :: Text
transformId :: Text
replaceAllLabels :: Maybe Bool
$sel:inputS3Path:StartImportLabelsTaskRun' :: StartImportLabelsTaskRun -> Text
$sel:transformId:StartImportLabelsTaskRun' :: StartImportLabelsTaskRun -> Text
$sel:replaceAllLabels:StartImportLabelsTaskRun' :: StartImportLabelsTaskRun -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
replaceAllLabels
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
transformId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
inputS3Path

instance Prelude.NFData StartImportLabelsTaskRun where
  rnf :: StartImportLabelsTaskRun -> ()
rnf StartImportLabelsTaskRun' {Maybe Bool
Text
inputS3Path :: Text
transformId :: Text
replaceAllLabels :: Maybe Bool
$sel:inputS3Path:StartImportLabelsTaskRun' :: StartImportLabelsTaskRun -> Text
$sel:transformId:StartImportLabelsTaskRun' :: StartImportLabelsTaskRun -> Text
$sel:replaceAllLabels:StartImportLabelsTaskRun' :: StartImportLabelsTaskRun -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
replaceAllLabels
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
inputS3Path

instance Data.ToHeaders StartImportLabelsTaskRun where
  toHeaders :: StartImportLabelsTaskRun -> 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.StartImportLabelsTaskRun" ::
                          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 StartImportLabelsTaskRun where
  toJSON :: StartImportLabelsTaskRun -> Value
toJSON StartImportLabelsTaskRun' {Maybe Bool
Text
inputS3Path :: Text
transformId :: Text
replaceAllLabels :: Maybe Bool
$sel:inputS3Path:StartImportLabelsTaskRun' :: StartImportLabelsTaskRun -> Text
$sel:transformId:StartImportLabelsTaskRun' :: StartImportLabelsTaskRun -> Text
$sel:replaceAllLabels:StartImportLabelsTaskRun' :: StartImportLabelsTaskRun -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ReplaceAllLabels" 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 Bool
replaceAllLabels,
            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
"InputS3Path" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
inputS3Path)
          ]
      )

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

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

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

-- |
-- Create a value of 'StartImportLabelsTaskRunResponse' 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', 'startImportLabelsTaskRunResponse_taskRunId' - The unique identifier for the task run.
--
-- 'httpStatus', 'startImportLabelsTaskRunResponse_httpStatus' - The response's http status code.
newStartImportLabelsTaskRunResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartImportLabelsTaskRunResponse
newStartImportLabelsTaskRunResponse :: Int -> StartImportLabelsTaskRunResponse
newStartImportLabelsTaskRunResponse Int
pHttpStatus_ =
  StartImportLabelsTaskRunResponse'
    { $sel:taskRunId:StartImportLabelsTaskRunResponse' :: Maybe Text
taskRunId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartImportLabelsTaskRunResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

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