{-# 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.Omics.StartAnnotationImportJob
-- 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 an annotation import job.
module Amazonka.Omics.StartAnnotationImportJob
  ( -- * Creating a Request
    StartAnnotationImportJob (..),
    newStartAnnotationImportJob,

    -- * Request Lenses
    startAnnotationImportJob_formatOptions,
    startAnnotationImportJob_runLeftNormalization,
    startAnnotationImportJob_destinationName,
    startAnnotationImportJob_items,
    startAnnotationImportJob_roleArn,

    -- * Destructuring the Response
    StartAnnotationImportJobResponse (..),
    newStartAnnotationImportJobResponse,

    -- * Response Lenses
    startAnnotationImportJobResponse_httpStatus,
    startAnnotationImportJobResponse_jobId,
  )
where

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

-- | /See:/ 'newStartAnnotationImportJob' smart constructor.
data StartAnnotationImportJob = StartAnnotationImportJob'
  { -- | Formatting options for the annotation file.
    StartAnnotationImportJob -> Maybe FormatOptions
formatOptions :: Prelude.Maybe FormatOptions,
    -- | The job\'s left normalization setting.
    StartAnnotationImportJob -> Maybe Bool
runLeftNormalization :: Prelude.Maybe Prelude.Bool,
    -- | A destination annotation store for the job.
    StartAnnotationImportJob -> Text
destinationName :: Prelude.Text,
    -- | Items to import.
    StartAnnotationImportJob -> NonEmpty AnnotationImportItemSource
items :: Prelude.NonEmpty AnnotationImportItemSource,
    -- | A service role for the job.
    StartAnnotationImportJob -> Text
roleArn :: Prelude.Text
  }
  deriving (StartAnnotationImportJob -> StartAnnotationImportJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartAnnotationImportJob -> StartAnnotationImportJob -> Bool
$c/= :: StartAnnotationImportJob -> StartAnnotationImportJob -> Bool
== :: StartAnnotationImportJob -> StartAnnotationImportJob -> Bool
$c== :: StartAnnotationImportJob -> StartAnnotationImportJob -> Bool
Prelude.Eq, ReadPrec [StartAnnotationImportJob]
ReadPrec StartAnnotationImportJob
Int -> ReadS StartAnnotationImportJob
ReadS [StartAnnotationImportJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartAnnotationImportJob]
$creadListPrec :: ReadPrec [StartAnnotationImportJob]
readPrec :: ReadPrec StartAnnotationImportJob
$creadPrec :: ReadPrec StartAnnotationImportJob
readList :: ReadS [StartAnnotationImportJob]
$creadList :: ReadS [StartAnnotationImportJob]
readsPrec :: Int -> ReadS StartAnnotationImportJob
$creadsPrec :: Int -> ReadS StartAnnotationImportJob
Prelude.Read, Int -> StartAnnotationImportJob -> ShowS
[StartAnnotationImportJob] -> ShowS
StartAnnotationImportJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartAnnotationImportJob] -> ShowS
$cshowList :: [StartAnnotationImportJob] -> ShowS
show :: StartAnnotationImportJob -> String
$cshow :: StartAnnotationImportJob -> String
showsPrec :: Int -> StartAnnotationImportJob -> ShowS
$cshowsPrec :: Int -> StartAnnotationImportJob -> ShowS
Prelude.Show, forall x.
Rep StartAnnotationImportJob x -> StartAnnotationImportJob
forall x.
StartAnnotationImportJob -> Rep StartAnnotationImportJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartAnnotationImportJob x -> StartAnnotationImportJob
$cfrom :: forall x.
StartAnnotationImportJob -> Rep StartAnnotationImportJob x
Prelude.Generic)

-- |
-- Create a value of 'StartAnnotationImportJob' 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:
--
-- 'formatOptions', 'startAnnotationImportJob_formatOptions' - Formatting options for the annotation file.
--
-- 'runLeftNormalization', 'startAnnotationImportJob_runLeftNormalization' - The job\'s left normalization setting.
--
-- 'destinationName', 'startAnnotationImportJob_destinationName' - A destination annotation store for the job.
--
-- 'items', 'startAnnotationImportJob_items' - Items to import.
--
-- 'roleArn', 'startAnnotationImportJob_roleArn' - A service role for the job.
newStartAnnotationImportJob ::
  -- | 'destinationName'
  Prelude.Text ->
  -- | 'items'
  Prelude.NonEmpty AnnotationImportItemSource ->
  -- | 'roleArn'
  Prelude.Text ->
  StartAnnotationImportJob
newStartAnnotationImportJob :: Text
-> NonEmpty AnnotationImportItemSource
-> Text
-> StartAnnotationImportJob
newStartAnnotationImportJob
  Text
pDestinationName_
  NonEmpty AnnotationImportItemSource
pItems_
  Text
pRoleArn_ =
    StartAnnotationImportJob'
      { $sel:formatOptions:StartAnnotationImportJob' :: Maybe FormatOptions
formatOptions =
          forall a. Maybe a
Prelude.Nothing,
        $sel:runLeftNormalization:StartAnnotationImportJob' :: Maybe Bool
runLeftNormalization = forall a. Maybe a
Prelude.Nothing,
        $sel:destinationName:StartAnnotationImportJob' :: Text
destinationName = Text
pDestinationName_,
        $sel:items:StartAnnotationImportJob' :: NonEmpty AnnotationImportItemSource
items = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty AnnotationImportItemSource
pItems_,
        $sel:roleArn:StartAnnotationImportJob' :: Text
roleArn = Text
pRoleArn_
      }

-- | Formatting options for the annotation file.
startAnnotationImportJob_formatOptions :: Lens.Lens' StartAnnotationImportJob (Prelude.Maybe FormatOptions)
startAnnotationImportJob_formatOptions :: Lens' StartAnnotationImportJob (Maybe FormatOptions)
startAnnotationImportJob_formatOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartAnnotationImportJob' {Maybe FormatOptions
formatOptions :: Maybe FormatOptions
$sel:formatOptions:StartAnnotationImportJob' :: StartAnnotationImportJob -> Maybe FormatOptions
formatOptions} -> Maybe FormatOptions
formatOptions) (\s :: StartAnnotationImportJob
s@StartAnnotationImportJob' {} Maybe FormatOptions
a -> StartAnnotationImportJob
s {$sel:formatOptions:StartAnnotationImportJob' :: Maybe FormatOptions
formatOptions = Maybe FormatOptions
a} :: StartAnnotationImportJob)

-- | The job\'s left normalization setting.
startAnnotationImportJob_runLeftNormalization :: Lens.Lens' StartAnnotationImportJob (Prelude.Maybe Prelude.Bool)
startAnnotationImportJob_runLeftNormalization :: Lens' StartAnnotationImportJob (Maybe Bool)
startAnnotationImportJob_runLeftNormalization = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartAnnotationImportJob' {Maybe Bool
runLeftNormalization :: Maybe Bool
$sel:runLeftNormalization:StartAnnotationImportJob' :: StartAnnotationImportJob -> Maybe Bool
runLeftNormalization} -> Maybe Bool
runLeftNormalization) (\s :: StartAnnotationImportJob
s@StartAnnotationImportJob' {} Maybe Bool
a -> StartAnnotationImportJob
s {$sel:runLeftNormalization:StartAnnotationImportJob' :: Maybe Bool
runLeftNormalization = Maybe Bool
a} :: StartAnnotationImportJob)

-- | A destination annotation store for the job.
startAnnotationImportJob_destinationName :: Lens.Lens' StartAnnotationImportJob Prelude.Text
startAnnotationImportJob_destinationName :: Lens' StartAnnotationImportJob Text
startAnnotationImportJob_destinationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartAnnotationImportJob' {Text
destinationName :: Text
$sel:destinationName:StartAnnotationImportJob' :: StartAnnotationImportJob -> Text
destinationName} -> Text
destinationName) (\s :: StartAnnotationImportJob
s@StartAnnotationImportJob' {} Text
a -> StartAnnotationImportJob
s {$sel:destinationName:StartAnnotationImportJob' :: Text
destinationName = Text
a} :: StartAnnotationImportJob)

-- | Items to import.
startAnnotationImportJob_items :: Lens.Lens' StartAnnotationImportJob (Prelude.NonEmpty AnnotationImportItemSource)
startAnnotationImportJob_items :: Lens'
  StartAnnotationImportJob (NonEmpty AnnotationImportItemSource)
startAnnotationImportJob_items = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartAnnotationImportJob' {NonEmpty AnnotationImportItemSource
items :: NonEmpty AnnotationImportItemSource
$sel:items:StartAnnotationImportJob' :: StartAnnotationImportJob -> NonEmpty AnnotationImportItemSource
items} -> NonEmpty AnnotationImportItemSource
items) (\s :: StartAnnotationImportJob
s@StartAnnotationImportJob' {} NonEmpty AnnotationImportItemSource
a -> StartAnnotationImportJob
s {$sel:items:StartAnnotationImportJob' :: NonEmpty AnnotationImportItemSource
items = NonEmpty AnnotationImportItemSource
a} :: StartAnnotationImportJob) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A service role for the job.
startAnnotationImportJob_roleArn :: Lens.Lens' StartAnnotationImportJob Prelude.Text
startAnnotationImportJob_roleArn :: Lens' StartAnnotationImportJob Text
startAnnotationImportJob_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartAnnotationImportJob' {Text
roleArn :: Text
$sel:roleArn:StartAnnotationImportJob' :: StartAnnotationImportJob -> Text
roleArn} -> Text
roleArn) (\s :: StartAnnotationImportJob
s@StartAnnotationImportJob' {} Text
a -> StartAnnotationImportJob
s {$sel:roleArn:StartAnnotationImportJob' :: Text
roleArn = Text
a} :: StartAnnotationImportJob)

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

instance Prelude.Hashable StartAnnotationImportJob where
  hashWithSalt :: Int -> StartAnnotationImportJob -> Int
hashWithSalt Int
_salt StartAnnotationImportJob' {Maybe Bool
Maybe FormatOptions
NonEmpty AnnotationImportItemSource
Text
roleArn :: Text
items :: NonEmpty AnnotationImportItemSource
destinationName :: Text
runLeftNormalization :: Maybe Bool
formatOptions :: Maybe FormatOptions
$sel:roleArn:StartAnnotationImportJob' :: StartAnnotationImportJob -> Text
$sel:items:StartAnnotationImportJob' :: StartAnnotationImportJob -> NonEmpty AnnotationImportItemSource
$sel:destinationName:StartAnnotationImportJob' :: StartAnnotationImportJob -> Text
$sel:runLeftNormalization:StartAnnotationImportJob' :: StartAnnotationImportJob -> Maybe Bool
$sel:formatOptions:StartAnnotationImportJob' :: StartAnnotationImportJob -> Maybe FormatOptions
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FormatOptions
formatOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
runLeftNormalization
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
destinationName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty AnnotationImportItemSource
items
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleArn

instance Prelude.NFData StartAnnotationImportJob where
  rnf :: StartAnnotationImportJob -> ()
rnf StartAnnotationImportJob' {Maybe Bool
Maybe FormatOptions
NonEmpty AnnotationImportItemSource
Text
roleArn :: Text
items :: NonEmpty AnnotationImportItemSource
destinationName :: Text
runLeftNormalization :: Maybe Bool
formatOptions :: Maybe FormatOptions
$sel:roleArn:StartAnnotationImportJob' :: StartAnnotationImportJob -> Text
$sel:items:StartAnnotationImportJob' :: StartAnnotationImportJob -> NonEmpty AnnotationImportItemSource
$sel:destinationName:StartAnnotationImportJob' :: StartAnnotationImportJob -> Text
$sel:runLeftNormalization:StartAnnotationImportJob' :: StartAnnotationImportJob -> Maybe Bool
$sel:formatOptions:StartAnnotationImportJob' :: StartAnnotationImportJob -> Maybe FormatOptions
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe FormatOptions
formatOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
runLeftNormalization
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
destinationName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty AnnotationImportItemSource
items
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roleArn

instance Data.ToHeaders StartAnnotationImportJob where
  toHeaders :: StartAnnotationImportJob -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON StartAnnotationImportJob where
  toJSON :: StartAnnotationImportJob -> Value
toJSON StartAnnotationImportJob' {Maybe Bool
Maybe FormatOptions
NonEmpty AnnotationImportItemSource
Text
roleArn :: Text
items :: NonEmpty AnnotationImportItemSource
destinationName :: Text
runLeftNormalization :: Maybe Bool
formatOptions :: Maybe FormatOptions
$sel:roleArn:StartAnnotationImportJob' :: StartAnnotationImportJob -> Text
$sel:items:StartAnnotationImportJob' :: StartAnnotationImportJob -> NonEmpty AnnotationImportItemSource
$sel:destinationName:StartAnnotationImportJob' :: StartAnnotationImportJob -> Text
$sel:runLeftNormalization:StartAnnotationImportJob' :: StartAnnotationImportJob -> Maybe Bool
$sel:formatOptions:StartAnnotationImportJob' :: StartAnnotationImportJob -> Maybe FormatOptions
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"formatOptions" 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 FormatOptions
formatOptions,
            (Key
"runLeftNormalization" 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
runLeftNormalization,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"destinationName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
destinationName),
            forall a. a -> Maybe a
Prelude.Just (Key
"items" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty AnnotationImportItemSource
items),
            forall a. a -> Maybe a
Prelude.Just (Key
"roleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
roleArn)
          ]
      )

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

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

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

-- |
-- Create a value of 'StartAnnotationImportJobResponse' 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', 'startAnnotationImportJobResponse_httpStatus' - The response's http status code.
--
-- 'jobId', 'startAnnotationImportJobResponse_jobId' - The job\'s ID.
newStartAnnotationImportJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'jobId'
  Prelude.Text ->
  StartAnnotationImportJobResponse
newStartAnnotationImportJobResponse :: Int -> Text -> StartAnnotationImportJobResponse
newStartAnnotationImportJobResponse
  Int
pHttpStatus_
  Text
pJobId_ =
    StartAnnotationImportJobResponse'
      { $sel:httpStatus:StartAnnotationImportJobResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:jobId:StartAnnotationImportJobResponse' :: Text
jobId = Text
pJobId_
      }

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

-- | The job\'s ID.
startAnnotationImportJobResponse_jobId :: Lens.Lens' StartAnnotationImportJobResponse Prelude.Text
startAnnotationImportJobResponse_jobId :: Lens' StartAnnotationImportJobResponse Text
startAnnotationImportJobResponse_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartAnnotationImportJobResponse' {Text
jobId :: Text
$sel:jobId:StartAnnotationImportJobResponse' :: StartAnnotationImportJobResponse -> Text
jobId} -> Text
jobId) (\s :: StartAnnotationImportJobResponse
s@StartAnnotationImportJobResponse' {} Text
a -> StartAnnotationImportJobResponse
s {$sel:jobId:StartAnnotationImportJobResponse' :: Text
jobId = Text
a} :: StartAnnotationImportJobResponse)

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