{-# 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 #-}
module Amazonka.Omics.GetVariantImportJob
(
GetVariantImportJob (..),
newGetVariantImportJob,
getVariantImportJob_jobId,
GetVariantImportJobResponse (..),
newGetVariantImportJobResponse,
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
data GetVariantImportJob = GetVariantImportJob'
{
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)
newGetVariantImportJob ::
Prelude.Text ->
GetVariantImportJob
newGetVariantImportJob :: Text -> GetVariantImportJob
newGetVariantImportJob Text
pJobId_ =
GetVariantImportJob' {$sel:jobId:GetVariantImportJob' :: Text
jobId = Text
pJobId_}
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
data GetVariantImportJobResponse = GetVariantImportJobResponse'
{
GetVariantImportJobResponse -> Maybe ISO8601
completionTime :: Prelude.Maybe Data.ISO8601,
GetVariantImportJobResponse -> Int
httpStatus :: Prelude.Int,
GetVariantImportJobResponse -> ISO8601
creationTime :: Data.ISO8601,
GetVariantImportJobResponse -> Text
destinationName :: Prelude.Text,
GetVariantImportJobResponse -> Text
id :: Prelude.Text,
GetVariantImportJobResponse -> NonEmpty VariantImportItemDetail
items :: Prelude.NonEmpty VariantImportItemDetail,
GetVariantImportJobResponse -> Text
roleArn :: Prelude.Text,
GetVariantImportJobResponse -> Bool
runLeftNormalization :: Prelude.Bool,
GetVariantImportJobResponse -> JobStatus
status :: JobStatus,
GetVariantImportJobResponse -> Text
statusMessage :: Prelude.Text,
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)
newGetVariantImportJobResponse ::
Prelude.Int ->
Prelude.UTCTime ->
Prelude.Text ->
Prelude.Text ->
Prelude.NonEmpty VariantImportItemDetail ->
Prelude.Text ->
Prelude.Bool ->
JobStatus ->
Prelude.Text ->
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_
}
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
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)
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
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)
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)
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
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)
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)
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)
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)
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