{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.DataExchange.Types.JobEntry
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.DataExchange.Types.JobEntry where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.DataExchange.Types.JobError
import Amazonka.DataExchange.Types.ResponseDetails
import Amazonka.DataExchange.Types.State
import Amazonka.DataExchange.Types.Type
import qualified Amazonka.Prelude as Prelude

-- | AWS Data Exchange Jobs are asynchronous import or export operations used
-- to create or copy assets. A data set owner can both import and export as
-- they see fit. Someone with an entitlement to a data set can only export.
-- Jobs are deleted 90 days after they are created.
--
-- /See:/ 'newJobEntry' smart constructor.
data JobEntry = JobEntry'
  { -- | Errors for jobs.
    JobEntry -> Maybe [JobError]
errors :: Prelude.Maybe [JobError],
    -- | The ARN for the job.
    JobEntry -> Text
arn :: Prelude.Text,
    -- | The date and time that the job was created, in ISO 8601 format.
    JobEntry -> ISO8601
createdAt :: Data.ISO8601,
    -- | Details of the operation to be performed by the job, such as export
    -- destination details or import source details.
    JobEntry -> ResponseDetails
details :: ResponseDetails,
    -- | The unique identifier for the job.
    JobEntry -> Text
id :: Prelude.Text,
    -- | The state of the job.
    JobEntry -> State
state :: State,
    -- | The job type.
    JobEntry -> Type
type' :: Type,
    -- | The date and time that the job was last updated, in ISO 8601 format.
    JobEntry -> ISO8601
updatedAt :: Data.ISO8601
  }
  deriving (JobEntry -> JobEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JobEntry -> JobEntry -> Bool
$c/= :: JobEntry -> JobEntry -> Bool
== :: JobEntry -> JobEntry -> Bool
$c== :: JobEntry -> JobEntry -> Bool
Prelude.Eq, ReadPrec [JobEntry]
ReadPrec JobEntry
Int -> ReadS JobEntry
ReadS [JobEntry]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [JobEntry]
$creadListPrec :: ReadPrec [JobEntry]
readPrec :: ReadPrec JobEntry
$creadPrec :: ReadPrec JobEntry
readList :: ReadS [JobEntry]
$creadList :: ReadS [JobEntry]
readsPrec :: Int -> ReadS JobEntry
$creadsPrec :: Int -> ReadS JobEntry
Prelude.Read, Int -> JobEntry -> ShowS
[JobEntry] -> ShowS
JobEntry -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JobEntry] -> ShowS
$cshowList :: [JobEntry] -> ShowS
show :: JobEntry -> String
$cshow :: JobEntry -> String
showsPrec :: Int -> JobEntry -> ShowS
$cshowsPrec :: Int -> JobEntry -> ShowS
Prelude.Show, forall x. Rep JobEntry x -> JobEntry
forall x. JobEntry -> Rep JobEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JobEntry x -> JobEntry
$cfrom :: forall x. JobEntry -> Rep JobEntry x
Prelude.Generic)

-- |
-- Create a value of 'JobEntry' 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:
--
-- 'errors', 'jobEntry_errors' - Errors for jobs.
--
-- 'arn', 'jobEntry_arn' - The ARN for the job.
--
-- 'createdAt', 'jobEntry_createdAt' - The date and time that the job was created, in ISO 8601 format.
--
-- 'details', 'jobEntry_details' - Details of the operation to be performed by the job, such as export
-- destination details or import source details.
--
-- 'id', 'jobEntry_id' - The unique identifier for the job.
--
-- 'state', 'jobEntry_state' - The state of the job.
--
-- 'type'', 'jobEntry_type' - The job type.
--
-- 'updatedAt', 'jobEntry_updatedAt' - The date and time that the job was last updated, in ISO 8601 format.
newJobEntry ::
  -- | 'arn'
  Prelude.Text ->
  -- | 'createdAt'
  Prelude.UTCTime ->
  -- | 'details'
  ResponseDetails ->
  -- | 'id'
  Prelude.Text ->
  -- | 'state'
  State ->
  -- | 'type''
  Type ->
  -- | 'updatedAt'
  Prelude.UTCTime ->
  JobEntry
newJobEntry :: Text
-> UTCTime
-> ResponseDetails
-> Text
-> State
-> Type
-> UTCTime
-> JobEntry
newJobEntry
  Text
pArn_
  UTCTime
pCreatedAt_
  ResponseDetails
pDetails_
  Text
pId_
  State
pState_
  Type
pType_
  UTCTime
pUpdatedAt_ =
    JobEntry'
      { $sel:errors:JobEntry' :: Maybe [JobError]
errors = forall a. Maybe a
Prelude.Nothing,
        $sel:arn:JobEntry' :: Text
arn = Text
pArn_,
        $sel:createdAt:JobEntry' :: ISO8601
createdAt = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreatedAt_,
        $sel:details:JobEntry' :: ResponseDetails
details = ResponseDetails
pDetails_,
        $sel:id:JobEntry' :: Text
id = Text
pId_,
        $sel:state:JobEntry' :: State
state = State
pState_,
        $sel:type':JobEntry' :: Type
type' = Type
pType_,
        $sel:updatedAt:JobEntry' :: ISO8601
updatedAt = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pUpdatedAt_
      }

-- | Errors for jobs.
jobEntry_errors :: Lens.Lens' JobEntry (Prelude.Maybe [JobError])
jobEntry_errors :: Lens' JobEntry (Maybe [JobError])
jobEntry_errors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobEntry' {Maybe [JobError]
errors :: Maybe [JobError]
$sel:errors:JobEntry' :: JobEntry -> Maybe [JobError]
errors} -> Maybe [JobError]
errors) (\s :: JobEntry
s@JobEntry' {} Maybe [JobError]
a -> JobEntry
s {$sel:errors:JobEntry' :: Maybe [JobError]
errors = Maybe [JobError]
a} :: JobEntry) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The ARN for the job.
jobEntry_arn :: Lens.Lens' JobEntry Prelude.Text
jobEntry_arn :: Lens' JobEntry Text
jobEntry_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobEntry' {Text
arn :: Text
$sel:arn:JobEntry' :: JobEntry -> Text
arn} -> Text
arn) (\s :: JobEntry
s@JobEntry' {} Text
a -> JobEntry
s {$sel:arn:JobEntry' :: Text
arn = Text
a} :: JobEntry)

-- | The date and time that the job was created, in ISO 8601 format.
jobEntry_createdAt :: Lens.Lens' JobEntry Prelude.UTCTime
jobEntry_createdAt :: Lens' JobEntry UTCTime
jobEntry_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobEntry' {ISO8601
createdAt :: ISO8601
$sel:createdAt:JobEntry' :: JobEntry -> ISO8601
createdAt} -> ISO8601
createdAt) (\s :: JobEntry
s@JobEntry' {} ISO8601
a -> JobEntry
s {$sel:createdAt:JobEntry' :: ISO8601
createdAt = ISO8601
a} :: JobEntry) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Details of the operation to be performed by the job, such as export
-- destination details or import source details.
jobEntry_details :: Lens.Lens' JobEntry ResponseDetails
jobEntry_details :: Lens' JobEntry ResponseDetails
jobEntry_details = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobEntry' {ResponseDetails
details :: ResponseDetails
$sel:details:JobEntry' :: JobEntry -> ResponseDetails
details} -> ResponseDetails
details) (\s :: JobEntry
s@JobEntry' {} ResponseDetails
a -> JobEntry
s {$sel:details:JobEntry' :: ResponseDetails
details = ResponseDetails
a} :: JobEntry)

-- | The unique identifier for the job.
jobEntry_id :: Lens.Lens' JobEntry Prelude.Text
jobEntry_id :: Lens' JobEntry Text
jobEntry_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobEntry' {Text
id :: Text
$sel:id:JobEntry' :: JobEntry -> Text
id} -> Text
id) (\s :: JobEntry
s@JobEntry' {} Text
a -> JobEntry
s {$sel:id:JobEntry' :: Text
id = Text
a} :: JobEntry)

-- | The state of the job.
jobEntry_state :: Lens.Lens' JobEntry State
jobEntry_state :: Lens' JobEntry State
jobEntry_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobEntry' {State
state :: State
$sel:state:JobEntry' :: JobEntry -> State
state} -> State
state) (\s :: JobEntry
s@JobEntry' {} State
a -> JobEntry
s {$sel:state:JobEntry' :: State
state = State
a} :: JobEntry)

-- | The job type.
jobEntry_type :: Lens.Lens' JobEntry Type
jobEntry_type :: Lens' JobEntry Type
jobEntry_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobEntry' {Type
type' :: Type
$sel:type':JobEntry' :: JobEntry -> Type
type'} -> Type
type') (\s :: JobEntry
s@JobEntry' {} Type
a -> JobEntry
s {$sel:type':JobEntry' :: Type
type' = Type
a} :: JobEntry)

-- | The date and time that the job was last updated, in ISO 8601 format.
jobEntry_updatedAt :: Lens.Lens' JobEntry Prelude.UTCTime
jobEntry_updatedAt :: Lens' JobEntry UTCTime
jobEntry_updatedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\JobEntry' {ISO8601
updatedAt :: ISO8601
$sel:updatedAt:JobEntry' :: JobEntry -> ISO8601
updatedAt} -> ISO8601
updatedAt) (\s :: JobEntry
s@JobEntry' {} ISO8601
a -> JobEntry
s {$sel:updatedAt:JobEntry' :: ISO8601
updatedAt = ISO8601
a} :: JobEntry) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Data.FromJSON JobEntry where
  parseJSON :: Value -> Parser JobEntry
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"JobEntry"
      ( \Object
x ->
          Maybe [JobError]
-> Text
-> ISO8601
-> ResponseDetails
-> Text
-> State
-> Type
-> ISO8601
-> JobEntry
JobEntry'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Errors" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"Arn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"CreatedAt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"Details")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser 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 -> Parser a
Data..: Key
"State")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"Type")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"UpdatedAt")
      )

instance Prelude.Hashable JobEntry where
  hashWithSalt :: Int -> JobEntry -> Int
hashWithSalt Int
_salt JobEntry' {Maybe [JobError]
Text
ISO8601
State
ResponseDetails
Type
updatedAt :: ISO8601
type' :: Type
state :: State
id :: Text
details :: ResponseDetails
createdAt :: ISO8601
arn :: Text
errors :: Maybe [JobError]
$sel:updatedAt:JobEntry' :: JobEntry -> ISO8601
$sel:type':JobEntry' :: JobEntry -> Type
$sel:state:JobEntry' :: JobEntry -> State
$sel:id:JobEntry' :: JobEntry -> Text
$sel:details:JobEntry' :: JobEntry -> ResponseDetails
$sel:createdAt:JobEntry' :: JobEntry -> ISO8601
$sel:arn:JobEntry' :: JobEntry -> Text
$sel:errors:JobEntry' :: JobEntry -> Maybe [JobError]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [JobError]
errors
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
arn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ISO8601
createdAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ResponseDetails
details
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` State
state
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Type
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ISO8601
updatedAt

instance Prelude.NFData JobEntry where
  rnf :: JobEntry -> ()
rnf JobEntry' {Maybe [JobError]
Text
ISO8601
State
ResponseDetails
Type
updatedAt :: ISO8601
type' :: Type
state :: State
id :: Text
details :: ResponseDetails
createdAt :: ISO8601
arn :: Text
errors :: Maybe [JobError]
$sel:updatedAt:JobEntry' :: JobEntry -> ISO8601
$sel:type':JobEntry' :: JobEntry -> Type
$sel:state:JobEntry' :: JobEntry -> State
$sel:id:JobEntry' :: JobEntry -> Text
$sel:details:JobEntry' :: JobEntry -> ResponseDetails
$sel:createdAt:JobEntry' :: JobEntry -> ISO8601
$sel:arn:JobEntry' :: JobEntry -> Text
$sel:errors:JobEntry' :: JobEntry -> Maybe [JobError]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [JobError]
errors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ISO8601
createdAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ResponseDetails
details
      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 State
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Type
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ISO8601
updatedAt