{-# 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.GetVariantImportJob
-- 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 a variant import job.
module Amazonka.Omics.GetVariantImportJob
  ( -- * Creating a Request
    GetVariantImportJob (..),
    newGetVariantImportJob,

    -- * Request Lenses
    getVariantImportJob_jobId,

    -- * Destructuring the Response
    GetVariantImportJobResponse (..),
    newGetVariantImportJobResponse,

    -- * Response Lenses
    getVariantImportJobResponse_completionTime,
    getVariantImportJobResponse_httpStatus,
    getVariantImportJobResponse_creationTime,
    getVariantImportJobResponse_destinationName,
    getVariantImportJobResponse_id,
    getVariantImportJobResponse_items,
    getVariantImportJobResponse_roleArn,
    getVariantImportJobResponse_runLeftNormalization,
    getVariantImportJobResponse_status,
    getVariantImportJobResponse_statusMessage,
    getVariantImportJobResponse_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:/ 'newGetVariantImportJob' smart constructor.
data GetVariantImportJob = GetVariantImportJob'
  { -- | The job\'s ID.
    GetVariantImportJob -> Text
jobId :: Prelude.Text
  }
  deriving (GetVariantImportJob -> GetVariantImportJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetVariantImportJob -> GetVariantImportJob -> Bool
$c/= :: GetVariantImportJob -> GetVariantImportJob -> Bool
== :: GetVariantImportJob -> GetVariantImportJob -> Bool
$c== :: GetVariantImportJob -> GetVariantImportJob -> Bool
Prelude.Eq, ReadPrec [GetVariantImportJob]
ReadPrec GetVariantImportJob
Int -> ReadS GetVariantImportJob
ReadS [GetVariantImportJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetVariantImportJob]
$creadListPrec :: ReadPrec [GetVariantImportJob]
readPrec :: ReadPrec GetVariantImportJob
$creadPrec :: ReadPrec GetVariantImportJob
readList :: ReadS [GetVariantImportJob]
$creadList :: ReadS [GetVariantImportJob]
readsPrec :: Int -> ReadS GetVariantImportJob
$creadsPrec :: Int -> ReadS GetVariantImportJob
Prelude.Read, Int -> GetVariantImportJob -> ShowS
[GetVariantImportJob] -> ShowS
GetVariantImportJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetVariantImportJob] -> ShowS
$cshowList :: [GetVariantImportJob] -> ShowS
show :: GetVariantImportJob -> String
$cshow :: GetVariantImportJob -> String
showsPrec :: Int -> GetVariantImportJob -> ShowS
$cshowsPrec :: Int -> GetVariantImportJob -> ShowS
Prelude.Show, forall x. Rep GetVariantImportJob x -> GetVariantImportJob
forall x. GetVariantImportJob -> Rep GetVariantImportJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetVariantImportJob x -> GetVariantImportJob
$cfrom :: forall x. GetVariantImportJob -> Rep GetVariantImportJob x
Prelude.Generic)

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

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

instance Core.AWSRequest GetVariantImportJob where
  type
    AWSResponse GetVariantImportJob =
      GetVariantImportJobResponse
  request :: (Service -> Service)
-> GetVariantImportJob -> Request GetVariantImportJob
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 GetVariantImportJob
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetVariantImportJob)))
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 ISO8601
-> Int
-> ISO8601
-> Text
-> Text
-> NonEmpty VariantImportItemDetail
-> Text
-> Bool
-> JobStatus
-> Text
-> ISO8601
-> GetVariantImportJobResponse
GetVariantImportJobResponse'
            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
"completionTime")
            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))
            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
"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 GetVariantImportJob where
  hashWithSalt :: Int -> GetVariantImportJob -> Int
hashWithSalt Int
_salt GetVariantImportJob' {Text
jobId :: Text
$sel:jobId:GetVariantImportJob' :: GetVariantImportJob -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobId

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

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

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

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

-- |
-- Create a value of 'GetVariantImportJobResponse' 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:
--
-- 'completionTime', 'getVariantImportJobResponse_completionTime' - When the job completed.
--
-- 'httpStatus', 'getVariantImportJobResponse_httpStatus' - The response's http status code.
--
-- 'creationTime', 'getVariantImportJobResponse_creationTime' - When the job was created.
--
-- 'destinationName', 'getVariantImportJobResponse_destinationName' - The job\'s destination variant store.
--
-- 'id', 'getVariantImportJobResponse_id' - The job\'s ID.
--
-- 'items', 'getVariantImportJobResponse_items' - The job\'s items.
--
-- 'roleArn', 'getVariantImportJobResponse_roleArn' - The job\'s service role ARN.
--
-- 'runLeftNormalization', 'getVariantImportJobResponse_runLeftNormalization' - The job\'s left normalization setting.
--
-- 'status', 'getVariantImportJobResponse_status' - The job\'s status.
--
-- 'statusMessage', 'getVariantImportJobResponse_statusMessage' - The job\'s status message.
--
-- 'updateTime', 'getVariantImportJobResponse_updateTime' - When the job was updated.
newGetVariantImportJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'creationTime'
  Prelude.UTCTime ->
  -- | 'destinationName'
  Prelude.Text ->
  -- | 'id'
  Prelude.Text ->
  -- | 'items'
  Prelude.NonEmpty VariantImportItemDetail ->
  -- | 'roleArn'
  Prelude.Text ->
  -- | 'runLeftNormalization'
  Prelude.Bool ->
  -- | 'status'
  JobStatus ->
  -- | 'statusMessage'
  Prelude.Text ->
  -- | 'updateTime'
  Prelude.UTCTime ->
  GetVariantImportJobResponse
newGetVariantImportJobResponse :: Int
-> UTCTime
-> Text
-> Text
-> NonEmpty VariantImportItemDetail
-> Text
-> Bool
-> JobStatus
-> Text
-> UTCTime
-> GetVariantImportJobResponse
newGetVariantImportJobResponse
  Int
pHttpStatus_
  UTCTime
pCreationTime_
  Text
pDestinationName_
  Text
pId_
  NonEmpty VariantImportItemDetail
pItems_
  Text
pRoleArn_
  Bool
pRunLeftNormalization_
  JobStatus
pStatus_
  Text
pStatusMessage_
  UTCTime
pUpdateTime_ =
    GetVariantImportJobResponse'
      { $sel:completionTime:GetVariantImportJobResponse' :: Maybe ISO8601
completionTime =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetVariantImportJobResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:creationTime:GetVariantImportJobResponse' :: ISO8601
creationTime =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreationTime_,
        $sel:destinationName:GetVariantImportJobResponse' :: Text
destinationName = Text
pDestinationName_,
        $sel:id:GetVariantImportJobResponse' :: Text
id = Text
pId_,
        $sel:items:GetVariantImportJobResponse' :: NonEmpty VariantImportItemDetail
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 VariantImportItemDetail
pItems_,
        $sel:roleArn:GetVariantImportJobResponse' :: Text
roleArn = Text
pRoleArn_,
        $sel:runLeftNormalization:GetVariantImportJobResponse' :: Bool
runLeftNormalization = Bool
pRunLeftNormalization_,
        $sel:status:GetVariantImportJobResponse' :: JobStatus
status = JobStatus
pStatus_,
        $sel:statusMessage:GetVariantImportJobResponse' :: Text
statusMessage = Text
pStatusMessage_,
        $sel:updateTime:GetVariantImportJobResponse' :: ISO8601
updateTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pUpdateTime_
      }

-- | When the job completed.
getVariantImportJobResponse_completionTime :: Lens.Lens' GetVariantImportJobResponse (Prelude.Maybe Prelude.UTCTime)
getVariantImportJobResponse_completionTime :: Lens' GetVariantImportJobResponse (Maybe UTCTime)
getVariantImportJobResponse_completionTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetVariantImportJobResponse' {Maybe ISO8601
completionTime :: Maybe ISO8601
$sel:completionTime:GetVariantImportJobResponse' :: GetVariantImportJobResponse -> Maybe ISO8601
completionTime} -> Maybe ISO8601
completionTime) (\s :: GetVariantImportJobResponse
s@GetVariantImportJobResponse' {} Maybe ISO8601
a -> GetVariantImportJobResponse
s {$sel:completionTime:GetVariantImportJobResponse' :: Maybe ISO8601
completionTime = Maybe ISO8601
a} :: GetVariantImportJobResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

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

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

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

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

-- | The job\'s items.
getVariantImportJobResponse_items :: Lens.Lens' GetVariantImportJobResponse (Prelude.NonEmpty VariantImportItemDetail)
getVariantImportJobResponse_items :: Lens'
  GetVariantImportJobResponse (NonEmpty VariantImportItemDetail)
getVariantImportJobResponse_items = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetVariantImportJobResponse' {NonEmpty VariantImportItemDetail
items :: NonEmpty VariantImportItemDetail
$sel:items:GetVariantImportJobResponse' :: GetVariantImportJobResponse -> NonEmpty VariantImportItemDetail
items} -> NonEmpty VariantImportItemDetail
items) (\s :: GetVariantImportJobResponse
s@GetVariantImportJobResponse' {} NonEmpty VariantImportItemDetail
a -> GetVariantImportJobResponse
s {$sel:items:GetVariantImportJobResponse' :: NonEmpty VariantImportItemDetail
items = NonEmpty VariantImportItemDetail
a} :: GetVariantImportJobResponse) 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.
getVariantImportJobResponse_roleArn :: Lens.Lens' GetVariantImportJobResponse Prelude.Text
getVariantImportJobResponse_roleArn :: Lens' GetVariantImportJobResponse Text
getVariantImportJobResponse_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetVariantImportJobResponse' {Text
roleArn :: Text
$sel:roleArn:GetVariantImportJobResponse' :: GetVariantImportJobResponse -> Text
roleArn} -> Text
roleArn) (\s :: GetVariantImportJobResponse
s@GetVariantImportJobResponse' {} Text
a -> GetVariantImportJobResponse
s {$sel:roleArn:GetVariantImportJobResponse' :: Text
roleArn = Text
a} :: GetVariantImportJobResponse)

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

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

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

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

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