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

    -- * Request Lenses
    getAnnotationImportJob_jobId,

    -- * Destructuring the Response
    GetAnnotationImportJobResponse (..),
    newGetAnnotationImportJobResponse,

    -- * Response Lenses
    getAnnotationImportJobResponse_httpStatus,
    getAnnotationImportJobResponse_completionTime,
    getAnnotationImportJobResponse_creationTime,
    getAnnotationImportJobResponse_destinationName,
    getAnnotationImportJobResponse_formatOptions,
    getAnnotationImportJobResponse_id,
    getAnnotationImportJobResponse_items,
    getAnnotationImportJobResponse_roleArn,
    getAnnotationImportJobResponse_runLeftNormalization,
    getAnnotationImportJobResponse_status,
    getAnnotationImportJobResponse_statusMessage,
    getAnnotationImportJobResponse_updateTime,
  )
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:/ 'newGetAnnotationImportJob' smart constructor.
data GetAnnotationImportJob = GetAnnotationImportJob'
  { -- | The job\'s ID.
    GetAnnotationImportJob -> Text
jobId :: Prelude.Text
  }
  deriving (GetAnnotationImportJob -> GetAnnotationImportJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetAnnotationImportJob -> GetAnnotationImportJob -> Bool
$c/= :: GetAnnotationImportJob -> GetAnnotationImportJob -> Bool
== :: GetAnnotationImportJob -> GetAnnotationImportJob -> Bool
$c== :: GetAnnotationImportJob -> GetAnnotationImportJob -> Bool
Prelude.Eq, ReadPrec [GetAnnotationImportJob]
ReadPrec GetAnnotationImportJob
Int -> ReadS GetAnnotationImportJob
ReadS [GetAnnotationImportJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetAnnotationImportJob]
$creadListPrec :: ReadPrec [GetAnnotationImportJob]
readPrec :: ReadPrec GetAnnotationImportJob
$creadPrec :: ReadPrec GetAnnotationImportJob
readList :: ReadS [GetAnnotationImportJob]
$creadList :: ReadS [GetAnnotationImportJob]
readsPrec :: Int -> ReadS GetAnnotationImportJob
$creadsPrec :: Int -> ReadS GetAnnotationImportJob
Prelude.Read, Int -> GetAnnotationImportJob -> ShowS
[GetAnnotationImportJob] -> ShowS
GetAnnotationImportJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetAnnotationImportJob] -> ShowS
$cshowList :: [GetAnnotationImportJob] -> ShowS
show :: GetAnnotationImportJob -> String
$cshow :: GetAnnotationImportJob -> String
showsPrec :: Int -> GetAnnotationImportJob -> ShowS
$cshowsPrec :: Int -> GetAnnotationImportJob -> ShowS
Prelude.Show, forall x. Rep GetAnnotationImportJob x -> GetAnnotationImportJob
forall x. GetAnnotationImportJob -> Rep GetAnnotationImportJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetAnnotationImportJob x -> GetAnnotationImportJob
$cfrom :: forall x. GetAnnotationImportJob -> Rep GetAnnotationImportJob x
Prelude.Generic)

-- |
-- Create a value of 'GetAnnotationImportJob' 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:
--
-- 'jobId', 'getAnnotationImportJob_jobId' - The job\'s ID.
newGetAnnotationImportJob ::
  -- | 'jobId'
  Prelude.Text ->
  GetAnnotationImportJob
newGetAnnotationImportJob :: Text -> GetAnnotationImportJob
newGetAnnotationImportJob Text
pJobId_ =
  GetAnnotationImportJob' {$sel:jobId:GetAnnotationImportJob' :: Text
jobId = Text
pJobId_}

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

instance Core.AWSRequest GetAnnotationImportJob where
  type
    AWSResponse GetAnnotationImportJob =
      GetAnnotationImportJobResponse
  request :: (Service -> Service)
-> GetAnnotationImportJob -> Request GetAnnotationImportJob
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetAnnotationImportJob
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetAnnotationImportJob)))
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
-> ISO8601
-> ISO8601
-> Text
-> FormatOptions
-> Text
-> NonEmpty AnnotationImportItemDetail
-> Text
-> Bool
-> JobStatus
-> Text
-> ISO8601
-> GetAnnotationImportJobResponse
GetAnnotationImportJobResponse'
            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
"completionTime")
            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
"creationTime")
            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
"destinationName")
            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
"formatOptions")
            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
"id")
            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
"items")
            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
"roleArn")
            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
"runLeftNormalization")
            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
"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 a
Data..:> Key
"statusMessage")
            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
"updateTime")
      )

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

instance Prelude.NFData GetAnnotationImportJob where
  rnf :: GetAnnotationImportJob -> ()
rnf GetAnnotationImportJob' {Text
jobId :: Text
$sel:jobId:GetAnnotationImportJob' :: GetAnnotationImportJob -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
jobId

instance Data.ToHeaders GetAnnotationImportJob where
  toHeaders :: GetAnnotationImportJob -> 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.ToPath GetAnnotationImportJob where
  toPath :: GetAnnotationImportJob -> ByteString
toPath GetAnnotationImportJob' {Text
jobId :: Text
$sel:jobId:GetAnnotationImportJob' :: GetAnnotationImportJob -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/import/annotation/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
jobId]

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

-- | /See:/ 'newGetAnnotationImportJobResponse' smart constructor.
data GetAnnotationImportJobResponse = GetAnnotationImportJobResponse'
  { -- | The response's http status code.
    GetAnnotationImportJobResponse -> Int
httpStatus :: Prelude.Int,
    -- | When the job completed.
    GetAnnotationImportJobResponse -> ISO8601
completionTime :: Data.ISO8601,
    -- | When the job was created.
    GetAnnotationImportJobResponse -> ISO8601
creationTime :: Data.ISO8601,
    -- | The job\'s destination annotation store.
    GetAnnotationImportJobResponse -> Text
destinationName :: Prelude.Text,
    GetAnnotationImportJobResponse -> FormatOptions
formatOptions :: FormatOptions,
    -- | The job\'s ID.
    GetAnnotationImportJobResponse -> Text
id :: Prelude.Text,
    -- | The job\'s imported items.
    GetAnnotationImportJobResponse
-> NonEmpty AnnotationImportItemDetail
items :: Prelude.NonEmpty AnnotationImportItemDetail,
    -- | The job\'s service role ARN.
    GetAnnotationImportJobResponse -> Text
roleArn :: Prelude.Text,
    -- | The job\'s left normalization setting.
    GetAnnotationImportJobResponse -> Bool
runLeftNormalization :: Prelude.Bool,
    -- | The job\'s status.
    GetAnnotationImportJobResponse -> JobStatus
status :: JobStatus,
    -- | The job\'s status message.
    GetAnnotationImportJobResponse -> Text
statusMessage :: Prelude.Text,
    -- | When the job was updated.
    GetAnnotationImportJobResponse -> ISO8601
updateTime :: Data.ISO8601
  }
  deriving (GetAnnotationImportJobResponse
-> GetAnnotationImportJobResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetAnnotationImportJobResponse
-> GetAnnotationImportJobResponse -> Bool
$c/= :: GetAnnotationImportJobResponse
-> GetAnnotationImportJobResponse -> Bool
== :: GetAnnotationImportJobResponse
-> GetAnnotationImportJobResponse -> Bool
$c== :: GetAnnotationImportJobResponse
-> GetAnnotationImportJobResponse -> Bool
Prelude.Eq, ReadPrec [GetAnnotationImportJobResponse]
ReadPrec GetAnnotationImportJobResponse
Int -> ReadS GetAnnotationImportJobResponse
ReadS [GetAnnotationImportJobResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetAnnotationImportJobResponse]
$creadListPrec :: ReadPrec [GetAnnotationImportJobResponse]
readPrec :: ReadPrec GetAnnotationImportJobResponse
$creadPrec :: ReadPrec GetAnnotationImportJobResponse
readList :: ReadS [GetAnnotationImportJobResponse]
$creadList :: ReadS [GetAnnotationImportJobResponse]
readsPrec :: Int -> ReadS GetAnnotationImportJobResponse
$creadsPrec :: Int -> ReadS GetAnnotationImportJobResponse
Prelude.Read, Int -> GetAnnotationImportJobResponse -> ShowS
[GetAnnotationImportJobResponse] -> ShowS
GetAnnotationImportJobResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetAnnotationImportJobResponse] -> ShowS
$cshowList :: [GetAnnotationImportJobResponse] -> ShowS
show :: GetAnnotationImportJobResponse -> String
$cshow :: GetAnnotationImportJobResponse -> String
showsPrec :: Int -> GetAnnotationImportJobResponse -> ShowS
$cshowsPrec :: Int -> GetAnnotationImportJobResponse -> ShowS
Prelude.Show, forall x.
Rep GetAnnotationImportJobResponse x
-> GetAnnotationImportJobResponse
forall x.
GetAnnotationImportJobResponse
-> Rep GetAnnotationImportJobResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetAnnotationImportJobResponse x
-> GetAnnotationImportJobResponse
$cfrom :: forall x.
GetAnnotationImportJobResponse
-> Rep GetAnnotationImportJobResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetAnnotationImportJobResponse' 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', 'getAnnotationImportJobResponse_httpStatus' - The response's http status code.
--
-- 'completionTime', 'getAnnotationImportJobResponse_completionTime' - When the job completed.
--
-- 'creationTime', 'getAnnotationImportJobResponse_creationTime' - When the job was created.
--
-- 'destinationName', 'getAnnotationImportJobResponse_destinationName' - The job\'s destination annotation store.
--
-- 'formatOptions', 'getAnnotationImportJobResponse_formatOptions' - Undocumented member.
--
-- 'id', 'getAnnotationImportJobResponse_id' - The job\'s ID.
--
-- 'items', 'getAnnotationImportJobResponse_items' - The job\'s imported items.
--
-- 'roleArn', 'getAnnotationImportJobResponse_roleArn' - The job\'s service role ARN.
--
-- 'runLeftNormalization', 'getAnnotationImportJobResponse_runLeftNormalization' - The job\'s left normalization setting.
--
-- 'status', 'getAnnotationImportJobResponse_status' - The job\'s status.
--
-- 'statusMessage', 'getAnnotationImportJobResponse_statusMessage' - The job\'s status message.
--
-- 'updateTime', 'getAnnotationImportJobResponse_updateTime' - When the job was updated.
newGetAnnotationImportJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'completionTime'
  Prelude.UTCTime ->
  -- | 'creationTime'
  Prelude.UTCTime ->
  -- | 'destinationName'
  Prelude.Text ->
  -- | 'formatOptions'
  FormatOptions ->
  -- | 'id'
  Prelude.Text ->
  -- | 'items'
  Prelude.NonEmpty AnnotationImportItemDetail ->
  -- | 'roleArn'
  Prelude.Text ->
  -- | 'runLeftNormalization'
  Prelude.Bool ->
  -- | 'status'
  JobStatus ->
  -- | 'statusMessage'
  Prelude.Text ->
  -- | 'updateTime'
  Prelude.UTCTime ->
  GetAnnotationImportJobResponse
newGetAnnotationImportJobResponse :: Int
-> UTCTime
-> UTCTime
-> Text
-> FormatOptions
-> Text
-> NonEmpty AnnotationImportItemDetail
-> Text
-> Bool
-> JobStatus
-> Text
-> UTCTime
-> GetAnnotationImportJobResponse
newGetAnnotationImportJobResponse
  Int
pHttpStatus_
  UTCTime
pCompletionTime_
  UTCTime
pCreationTime_
  Text
pDestinationName_
  FormatOptions
pFormatOptions_
  Text
pId_
  NonEmpty AnnotationImportItemDetail
pItems_
  Text
pRoleArn_
  Bool
pRunLeftNormalization_
  JobStatus
pStatus_
  Text
pStatusMessage_
  UTCTime
pUpdateTime_ =
    GetAnnotationImportJobResponse'
      { $sel:httpStatus:GetAnnotationImportJobResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:completionTime:GetAnnotationImportJobResponse' :: ISO8601
completionTime =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCompletionTime_,
        $sel:creationTime:GetAnnotationImportJobResponse' :: ISO8601
creationTime =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreationTime_,
        $sel:destinationName:GetAnnotationImportJobResponse' :: Text
destinationName = Text
pDestinationName_,
        $sel:formatOptions:GetAnnotationImportJobResponse' :: FormatOptions
formatOptions = FormatOptions
pFormatOptions_,
        $sel:id:GetAnnotationImportJobResponse' :: Text
id = Text
pId_,
        $sel:items:GetAnnotationImportJobResponse' :: NonEmpty AnnotationImportItemDetail
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 AnnotationImportItemDetail
pItems_,
        $sel:roleArn:GetAnnotationImportJobResponse' :: Text
roleArn = Text
pRoleArn_,
        $sel:runLeftNormalization:GetAnnotationImportJobResponse' :: Bool
runLeftNormalization =
          Bool
pRunLeftNormalization_,
        $sel:status:GetAnnotationImportJobResponse' :: JobStatus
status = JobStatus
pStatus_,
        $sel:statusMessage:GetAnnotationImportJobResponse' :: Text
statusMessage = Text
pStatusMessage_,
        $sel:updateTime:GetAnnotationImportJobResponse' :: ISO8601
updateTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pUpdateTime_
      }

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

-- | When the job completed.
getAnnotationImportJobResponse_completionTime :: Lens.Lens' GetAnnotationImportJobResponse Prelude.UTCTime
getAnnotationImportJobResponse_completionTime :: Lens' GetAnnotationImportJobResponse UTCTime
getAnnotationImportJobResponse_completionTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAnnotationImportJobResponse' {ISO8601
completionTime :: ISO8601
$sel:completionTime:GetAnnotationImportJobResponse' :: GetAnnotationImportJobResponse -> ISO8601
completionTime} -> ISO8601
completionTime) (\s :: GetAnnotationImportJobResponse
s@GetAnnotationImportJobResponse' {} ISO8601
a -> GetAnnotationImportJobResponse
s {$sel:completionTime:GetAnnotationImportJobResponse' :: ISO8601
completionTime = ISO8601
a} :: GetAnnotationImportJobResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | When the job was created.
getAnnotationImportJobResponse_creationTime :: Lens.Lens' GetAnnotationImportJobResponse Prelude.UTCTime
getAnnotationImportJobResponse_creationTime :: Lens' GetAnnotationImportJobResponse UTCTime
getAnnotationImportJobResponse_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAnnotationImportJobResponse' {ISO8601
creationTime :: ISO8601
$sel:creationTime:GetAnnotationImportJobResponse' :: GetAnnotationImportJobResponse -> ISO8601
creationTime} -> ISO8601
creationTime) (\s :: GetAnnotationImportJobResponse
s@GetAnnotationImportJobResponse' {} ISO8601
a -> GetAnnotationImportJobResponse
s {$sel:creationTime:GetAnnotationImportJobResponse' :: ISO8601
creationTime = ISO8601
a} :: GetAnnotationImportJobResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The job\'s destination annotation store.
getAnnotationImportJobResponse_destinationName :: Lens.Lens' GetAnnotationImportJobResponse Prelude.Text
getAnnotationImportJobResponse_destinationName :: Lens' GetAnnotationImportJobResponse Text
getAnnotationImportJobResponse_destinationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAnnotationImportJobResponse' {Text
destinationName :: Text
$sel:destinationName:GetAnnotationImportJobResponse' :: GetAnnotationImportJobResponse -> Text
destinationName} -> Text
destinationName) (\s :: GetAnnotationImportJobResponse
s@GetAnnotationImportJobResponse' {} Text
a -> GetAnnotationImportJobResponse
s {$sel:destinationName:GetAnnotationImportJobResponse' :: Text
destinationName = Text
a} :: GetAnnotationImportJobResponse)

-- | Undocumented member.
getAnnotationImportJobResponse_formatOptions :: Lens.Lens' GetAnnotationImportJobResponse FormatOptions
getAnnotationImportJobResponse_formatOptions :: Lens' GetAnnotationImportJobResponse FormatOptions
getAnnotationImportJobResponse_formatOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAnnotationImportJobResponse' {FormatOptions
formatOptions :: FormatOptions
$sel:formatOptions:GetAnnotationImportJobResponse' :: GetAnnotationImportJobResponse -> FormatOptions
formatOptions} -> FormatOptions
formatOptions) (\s :: GetAnnotationImportJobResponse
s@GetAnnotationImportJobResponse' {} FormatOptions
a -> GetAnnotationImportJobResponse
s {$sel:formatOptions:GetAnnotationImportJobResponse' :: FormatOptions
formatOptions = FormatOptions
a} :: GetAnnotationImportJobResponse)

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

-- | The job\'s imported items.
getAnnotationImportJobResponse_items :: Lens.Lens' GetAnnotationImportJobResponse (Prelude.NonEmpty AnnotationImportItemDetail)
getAnnotationImportJobResponse_items :: Lens'
  GetAnnotationImportJobResponse
  (NonEmpty AnnotationImportItemDetail)
getAnnotationImportJobResponse_items = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAnnotationImportJobResponse' {NonEmpty AnnotationImportItemDetail
items :: NonEmpty AnnotationImportItemDetail
$sel:items:GetAnnotationImportJobResponse' :: GetAnnotationImportJobResponse
-> NonEmpty AnnotationImportItemDetail
items} -> NonEmpty AnnotationImportItemDetail
items) (\s :: GetAnnotationImportJobResponse
s@GetAnnotationImportJobResponse' {} NonEmpty AnnotationImportItemDetail
a -> GetAnnotationImportJobResponse
s {$sel:items:GetAnnotationImportJobResponse' :: NonEmpty AnnotationImportItemDetail
items = NonEmpty AnnotationImportItemDetail
a} :: GetAnnotationImportJobResponse) 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

-- | The job\'s service role ARN.
getAnnotationImportJobResponse_roleArn :: Lens.Lens' GetAnnotationImportJobResponse Prelude.Text
getAnnotationImportJobResponse_roleArn :: Lens' GetAnnotationImportJobResponse Text
getAnnotationImportJobResponse_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAnnotationImportJobResponse' {Text
roleArn :: Text
$sel:roleArn:GetAnnotationImportJobResponse' :: GetAnnotationImportJobResponse -> Text
roleArn} -> Text
roleArn) (\s :: GetAnnotationImportJobResponse
s@GetAnnotationImportJobResponse' {} Text
a -> GetAnnotationImportJobResponse
s {$sel:roleArn:GetAnnotationImportJobResponse' :: Text
roleArn = Text
a} :: GetAnnotationImportJobResponse)

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

-- | The job\'s status.
getAnnotationImportJobResponse_status :: Lens.Lens' GetAnnotationImportJobResponse JobStatus
getAnnotationImportJobResponse_status :: Lens' GetAnnotationImportJobResponse JobStatus
getAnnotationImportJobResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAnnotationImportJobResponse' {JobStatus
status :: JobStatus
$sel:status:GetAnnotationImportJobResponse' :: GetAnnotationImportJobResponse -> JobStatus
status} -> JobStatus
status) (\s :: GetAnnotationImportJobResponse
s@GetAnnotationImportJobResponse' {} JobStatus
a -> GetAnnotationImportJobResponse
s {$sel:status:GetAnnotationImportJobResponse' :: JobStatus
status = JobStatus
a} :: GetAnnotationImportJobResponse)

-- | The job\'s status message.
getAnnotationImportJobResponse_statusMessage :: Lens.Lens' GetAnnotationImportJobResponse Prelude.Text
getAnnotationImportJobResponse_statusMessage :: Lens' GetAnnotationImportJobResponse Text
getAnnotationImportJobResponse_statusMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAnnotationImportJobResponse' {Text
statusMessage :: Text
$sel:statusMessage:GetAnnotationImportJobResponse' :: GetAnnotationImportJobResponse -> Text
statusMessage} -> Text
statusMessage) (\s :: GetAnnotationImportJobResponse
s@GetAnnotationImportJobResponse' {} Text
a -> GetAnnotationImportJobResponse
s {$sel:statusMessage:GetAnnotationImportJobResponse' :: Text
statusMessage = Text
a} :: GetAnnotationImportJobResponse)

-- | When the job was updated.
getAnnotationImportJobResponse_updateTime :: Lens.Lens' GetAnnotationImportJobResponse Prelude.UTCTime
getAnnotationImportJobResponse_updateTime :: Lens' GetAnnotationImportJobResponse UTCTime
getAnnotationImportJobResponse_updateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAnnotationImportJobResponse' {ISO8601
updateTime :: ISO8601
$sel:updateTime:GetAnnotationImportJobResponse' :: GetAnnotationImportJobResponse -> ISO8601
updateTime} -> ISO8601
updateTime) (\s :: GetAnnotationImportJobResponse
s@GetAnnotationImportJobResponse' {} ISO8601
a -> GetAnnotationImportJobResponse
s {$sel:updateTime:GetAnnotationImportJobResponse' :: ISO8601
updateTime = ISO8601
a} :: GetAnnotationImportJobResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance
  Prelude.NFData
    GetAnnotationImportJobResponse
  where
  rnf :: GetAnnotationImportJobResponse -> ()
rnf GetAnnotationImportJobResponse' {Bool
Int
NonEmpty AnnotationImportItemDetail
Text
ISO8601
JobStatus
FormatOptions
updateTime :: ISO8601
statusMessage :: Text
status :: JobStatus
runLeftNormalization :: Bool
roleArn :: Text
items :: NonEmpty AnnotationImportItemDetail
id :: Text
formatOptions :: FormatOptions
destinationName :: Text
creationTime :: ISO8601
completionTime :: ISO8601
httpStatus :: Int
$sel:updateTime:GetAnnotationImportJobResponse' :: GetAnnotationImportJobResponse -> ISO8601
$sel:statusMessage:GetAnnotationImportJobResponse' :: GetAnnotationImportJobResponse -> Text
$sel:status:GetAnnotationImportJobResponse' :: GetAnnotationImportJobResponse -> JobStatus
$sel:runLeftNormalization:GetAnnotationImportJobResponse' :: GetAnnotationImportJobResponse -> Bool
$sel:roleArn:GetAnnotationImportJobResponse' :: GetAnnotationImportJobResponse -> Text
$sel:items:GetAnnotationImportJobResponse' :: GetAnnotationImportJobResponse
-> NonEmpty AnnotationImportItemDetail
$sel:id:GetAnnotationImportJobResponse' :: GetAnnotationImportJobResponse -> Text
$sel:formatOptions:GetAnnotationImportJobResponse' :: GetAnnotationImportJobResponse -> FormatOptions
$sel:destinationName:GetAnnotationImportJobResponse' :: GetAnnotationImportJobResponse -> Text
$sel:creationTime:GetAnnotationImportJobResponse' :: GetAnnotationImportJobResponse -> ISO8601
$sel:completionTime:GetAnnotationImportJobResponse' :: GetAnnotationImportJobResponse -> ISO8601
$sel:httpStatus:GetAnnotationImportJobResponse' :: GetAnnotationImportJobResponse -> 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 ISO8601
completionTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ISO8601
creationTime
      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 FormatOptions
formatOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty AnnotationImportItemDetail
items
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Bool
runLeftNormalization
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf JobStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
statusMessage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ISO8601
updateTime