{-# 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.DeviceFarm.Types.Job
-- 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.DeviceFarm.Types.Job where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.DeviceFarm.Types.Counters
import Amazonka.DeviceFarm.Types.Device
import Amazonka.DeviceFarm.Types.DeviceMinutes
import Amazonka.DeviceFarm.Types.ExecutionResult
import Amazonka.DeviceFarm.Types.ExecutionStatus
import Amazonka.DeviceFarm.Types.TestType
import qualified Amazonka.Prelude as Prelude

-- | Represents a device.
--
-- /See:/ 'newJob' smart constructor.
data Job = Job'
  { -- | The job\'s ARN.
    Job -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The job\'s result counters.
    Job -> Maybe Counters
counters :: Prelude.Maybe Counters,
    -- | When the job was created.
    Job -> Maybe POSIX
created :: Prelude.Maybe Data.POSIX,
    -- | The device (phone or tablet).
    Job -> Maybe Device
device :: Prelude.Maybe Device,
    -- | Represents the total (metered or unmetered) minutes used by the job.
    Job -> Maybe DeviceMinutes
deviceMinutes :: Prelude.Maybe DeviceMinutes,
    -- | The ARN of the instance.
    Job -> Maybe Text
instanceArn :: Prelude.Maybe Prelude.Text,
    -- | A message about the job\'s result.
    Job -> Maybe Text
message :: Prelude.Maybe Prelude.Text,
    -- | The job\'s name.
    Job -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The job\'s result.
    --
    -- Allowed values include:
    --
    -- -   PENDING
    --
    -- -   PASSED
    --
    -- -   WARNED
    --
    -- -   FAILED
    --
    -- -   SKIPPED
    --
    -- -   ERRORED
    --
    -- -   STOPPED
    Job -> Maybe ExecutionResult
result :: Prelude.Maybe ExecutionResult,
    -- | The job\'s start time.
    Job -> Maybe POSIX
started :: Prelude.Maybe Data.POSIX,
    -- | The job\'s status.
    --
    -- Allowed values include:
    --
    -- -   PENDING
    --
    -- -   PENDING_CONCURRENCY
    --
    -- -   PENDING_DEVICE
    --
    -- -   PROCESSING
    --
    -- -   SCHEDULING
    --
    -- -   PREPARING
    --
    -- -   RUNNING
    --
    -- -   COMPLETED
    --
    -- -   STOPPING
    Job -> Maybe ExecutionStatus
status :: Prelude.Maybe ExecutionStatus,
    -- | The job\'s stop time.
    Job -> Maybe POSIX
stopped :: Prelude.Maybe Data.POSIX,
    -- | The job\'s type.
    --
    -- Allowed values include the following:
    --
    -- -   BUILTIN_FUZZ
    --
    -- -   BUILTIN_EXPLORER. For Android, an app explorer that traverses an
    --     Android app, interacting with it and capturing screenshots at the
    --     same time.
    --
    -- -   APPIUM_JAVA_JUNIT
    --
    -- -   APPIUM_JAVA_TESTNG
    --
    -- -   APPIUM_PYTHON
    --
    -- -   APPIUM_NODE
    --
    -- -   APPIUM_RUBY
    --
    -- -   APPIUM_WEB_JAVA_JUNIT
    --
    -- -   APPIUM_WEB_JAVA_TESTNG
    --
    -- -   APPIUM_WEB_PYTHON
    --
    -- -   APPIUM_WEB_NODE
    --
    -- -   APPIUM_WEB_RUBY
    --
    -- -   CALABASH
    --
    -- -   INSTRUMENTATION
    --
    -- -   UIAUTOMATION
    --
    -- -   UIAUTOMATOR
    --
    -- -   XCTEST
    --
    -- -   XCTEST_UI
    Job -> Maybe TestType
type' :: Prelude.Maybe TestType,
    -- | This value is set to true if video capture is enabled. Otherwise, it is
    -- set to false.
    Job -> Maybe Bool
videoCapture :: Prelude.Maybe Prelude.Bool,
    -- | The endpoint for streaming device video.
    Job -> Maybe Text
videoEndpoint :: Prelude.Maybe Prelude.Text
  }
  deriving (Job -> Job -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Job -> Job -> Bool
$c/= :: Job -> Job -> Bool
== :: Job -> Job -> Bool
$c== :: Job -> Job -> Bool
Prelude.Eq, ReadPrec [Job]
ReadPrec Job
Int -> ReadS Job
ReadS [Job]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Job]
$creadListPrec :: ReadPrec [Job]
readPrec :: ReadPrec Job
$creadPrec :: ReadPrec Job
readList :: ReadS [Job]
$creadList :: ReadS [Job]
readsPrec :: Int -> ReadS Job
$creadsPrec :: Int -> ReadS Job
Prelude.Read, Int -> Job -> ShowS
[Job] -> ShowS
Job -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Job] -> ShowS
$cshowList :: [Job] -> ShowS
show :: Job -> String
$cshow :: Job -> String
showsPrec :: Int -> Job -> ShowS
$cshowsPrec :: Int -> Job -> ShowS
Prelude.Show, forall x. Rep Job x -> Job
forall x. Job -> Rep Job x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Job x -> Job
$cfrom :: forall x. Job -> Rep Job x
Prelude.Generic)

-- |
-- Create a value of 'Job' 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:
--
-- 'arn', 'job_arn' - The job\'s ARN.
--
-- 'counters', 'job_counters' - The job\'s result counters.
--
-- 'created', 'job_created' - When the job was created.
--
-- 'device', 'job_device' - The device (phone or tablet).
--
-- 'deviceMinutes', 'job_deviceMinutes' - Represents the total (metered or unmetered) minutes used by the job.
--
-- 'instanceArn', 'job_instanceArn' - The ARN of the instance.
--
-- 'message', 'job_message' - A message about the job\'s result.
--
-- 'name', 'job_name' - The job\'s name.
--
-- 'result', 'job_result' - The job\'s result.
--
-- Allowed values include:
--
-- -   PENDING
--
-- -   PASSED
--
-- -   WARNED
--
-- -   FAILED
--
-- -   SKIPPED
--
-- -   ERRORED
--
-- -   STOPPED
--
-- 'started', 'job_started' - The job\'s start time.
--
-- 'status', 'job_status' - The job\'s status.
--
-- Allowed values include:
--
-- -   PENDING
--
-- -   PENDING_CONCURRENCY
--
-- -   PENDING_DEVICE
--
-- -   PROCESSING
--
-- -   SCHEDULING
--
-- -   PREPARING
--
-- -   RUNNING
--
-- -   COMPLETED
--
-- -   STOPPING
--
-- 'stopped', 'job_stopped' - The job\'s stop time.
--
-- 'type'', 'job_type' - The job\'s type.
--
-- Allowed values include the following:
--
-- -   BUILTIN_FUZZ
--
-- -   BUILTIN_EXPLORER. For Android, an app explorer that traverses an
--     Android app, interacting with it and capturing screenshots at the
--     same time.
--
-- -   APPIUM_JAVA_JUNIT
--
-- -   APPIUM_JAVA_TESTNG
--
-- -   APPIUM_PYTHON
--
-- -   APPIUM_NODE
--
-- -   APPIUM_RUBY
--
-- -   APPIUM_WEB_JAVA_JUNIT
--
-- -   APPIUM_WEB_JAVA_TESTNG
--
-- -   APPIUM_WEB_PYTHON
--
-- -   APPIUM_WEB_NODE
--
-- -   APPIUM_WEB_RUBY
--
-- -   CALABASH
--
-- -   INSTRUMENTATION
--
-- -   UIAUTOMATION
--
-- -   UIAUTOMATOR
--
-- -   XCTEST
--
-- -   XCTEST_UI
--
-- 'videoCapture', 'job_videoCapture' - This value is set to true if video capture is enabled. Otherwise, it is
-- set to false.
--
-- 'videoEndpoint', 'job_videoEndpoint' - The endpoint for streaming device video.
newJob ::
  Job
newJob :: Job
newJob =
  Job'
    { $sel:arn:Job' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:counters:Job' :: Maybe Counters
counters = forall a. Maybe a
Prelude.Nothing,
      $sel:created:Job' :: Maybe POSIX
created = forall a. Maybe a
Prelude.Nothing,
      $sel:device:Job' :: Maybe Device
device = forall a. Maybe a
Prelude.Nothing,
      $sel:deviceMinutes:Job' :: Maybe DeviceMinutes
deviceMinutes = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceArn:Job' :: Maybe Text
instanceArn = forall a. Maybe a
Prelude.Nothing,
      $sel:message:Job' :: Maybe Text
message = forall a. Maybe a
Prelude.Nothing,
      $sel:name:Job' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:result:Job' :: Maybe ExecutionResult
result = forall a. Maybe a
Prelude.Nothing,
      $sel:started:Job' :: Maybe POSIX
started = forall a. Maybe a
Prelude.Nothing,
      $sel:status:Job' :: Maybe ExecutionStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:stopped:Job' :: Maybe POSIX
stopped = forall a. Maybe a
Prelude.Nothing,
      $sel:type':Job' :: Maybe TestType
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:videoCapture:Job' :: Maybe Bool
videoCapture = forall a. Maybe a
Prelude.Nothing,
      $sel:videoEndpoint:Job' :: Maybe Text
videoEndpoint = forall a. Maybe a
Prelude.Nothing
    }

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

-- | The job\'s result counters.
job_counters :: Lens.Lens' Job (Prelude.Maybe Counters)
job_counters :: Lens' Job (Maybe Counters)
job_counters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Job' {Maybe Counters
counters :: Maybe Counters
$sel:counters:Job' :: Job -> Maybe Counters
counters} -> Maybe Counters
counters) (\s :: Job
s@Job' {} Maybe Counters
a -> Job
s {$sel:counters:Job' :: Maybe Counters
counters = Maybe Counters
a} :: Job)

-- | When the job was created.
job_created :: Lens.Lens' Job (Prelude.Maybe Prelude.UTCTime)
job_created :: Lens' Job (Maybe UTCTime)
job_created = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Job' {Maybe POSIX
created :: Maybe POSIX
$sel:created:Job' :: Job -> Maybe POSIX
created} -> Maybe POSIX
created) (\s :: Job
s@Job' {} Maybe POSIX
a -> Job
s {$sel:created:Job' :: Maybe POSIX
created = Maybe POSIX
a} :: Job) 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 device (phone or tablet).
job_device :: Lens.Lens' Job (Prelude.Maybe Device)
job_device :: Lens' Job (Maybe Device)
job_device = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Job' {Maybe Device
device :: Maybe Device
$sel:device:Job' :: Job -> Maybe Device
device} -> Maybe Device
device) (\s :: Job
s@Job' {} Maybe Device
a -> Job
s {$sel:device:Job' :: Maybe Device
device = Maybe Device
a} :: Job)

-- | Represents the total (metered or unmetered) minutes used by the job.
job_deviceMinutes :: Lens.Lens' Job (Prelude.Maybe DeviceMinutes)
job_deviceMinutes :: Lens' Job (Maybe DeviceMinutes)
job_deviceMinutes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Job' {Maybe DeviceMinutes
deviceMinutes :: Maybe DeviceMinutes
$sel:deviceMinutes:Job' :: Job -> Maybe DeviceMinutes
deviceMinutes} -> Maybe DeviceMinutes
deviceMinutes) (\s :: Job
s@Job' {} Maybe DeviceMinutes
a -> Job
s {$sel:deviceMinutes:Job' :: Maybe DeviceMinutes
deviceMinutes = Maybe DeviceMinutes
a} :: Job)

-- | The ARN of the instance.
job_instanceArn :: Lens.Lens' Job (Prelude.Maybe Prelude.Text)
job_instanceArn :: Lens' Job (Maybe Text)
job_instanceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Job' {Maybe Text
instanceArn :: Maybe Text
$sel:instanceArn:Job' :: Job -> Maybe Text
instanceArn} -> Maybe Text
instanceArn) (\s :: Job
s@Job' {} Maybe Text
a -> Job
s {$sel:instanceArn:Job' :: Maybe Text
instanceArn = Maybe Text
a} :: Job)

-- | A message about the job\'s result.
job_message :: Lens.Lens' Job (Prelude.Maybe Prelude.Text)
job_message :: Lens' Job (Maybe Text)
job_message = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Job' {Maybe Text
message :: Maybe Text
$sel:message:Job' :: Job -> Maybe Text
message} -> Maybe Text
message) (\s :: Job
s@Job' {} Maybe Text
a -> Job
s {$sel:message:Job' :: Maybe Text
message = Maybe Text
a} :: Job)

-- | The job\'s name.
job_name :: Lens.Lens' Job (Prelude.Maybe Prelude.Text)
job_name :: Lens' Job (Maybe Text)
job_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Job' {Maybe Text
name :: Maybe Text
$sel:name:Job' :: Job -> Maybe Text
name} -> Maybe Text
name) (\s :: Job
s@Job' {} Maybe Text
a -> Job
s {$sel:name:Job' :: Maybe Text
name = Maybe Text
a} :: Job)

-- | The job\'s result.
--
-- Allowed values include:
--
-- -   PENDING
--
-- -   PASSED
--
-- -   WARNED
--
-- -   FAILED
--
-- -   SKIPPED
--
-- -   ERRORED
--
-- -   STOPPED
job_result :: Lens.Lens' Job (Prelude.Maybe ExecutionResult)
job_result :: Lens' Job (Maybe ExecutionResult)
job_result = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Job' {Maybe ExecutionResult
result :: Maybe ExecutionResult
$sel:result:Job' :: Job -> Maybe ExecutionResult
result} -> Maybe ExecutionResult
result) (\s :: Job
s@Job' {} Maybe ExecutionResult
a -> Job
s {$sel:result:Job' :: Maybe ExecutionResult
result = Maybe ExecutionResult
a} :: Job)

-- | The job\'s start time.
job_started :: Lens.Lens' Job (Prelude.Maybe Prelude.UTCTime)
job_started :: Lens' Job (Maybe UTCTime)
job_started = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Job' {Maybe POSIX
started :: Maybe POSIX
$sel:started:Job' :: Job -> Maybe POSIX
started} -> Maybe POSIX
started) (\s :: Job
s@Job' {} Maybe POSIX
a -> Job
s {$sel:started:Job' :: Maybe POSIX
started = Maybe POSIX
a} :: Job) 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 job\'s status.
--
-- Allowed values include:
--
-- -   PENDING
--
-- -   PENDING_CONCURRENCY
--
-- -   PENDING_DEVICE
--
-- -   PROCESSING
--
-- -   SCHEDULING
--
-- -   PREPARING
--
-- -   RUNNING
--
-- -   COMPLETED
--
-- -   STOPPING
job_status :: Lens.Lens' Job (Prelude.Maybe ExecutionStatus)
job_status :: Lens' Job (Maybe ExecutionStatus)
job_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Job' {Maybe ExecutionStatus
status :: Maybe ExecutionStatus
$sel:status:Job' :: Job -> Maybe ExecutionStatus
status} -> Maybe ExecutionStatus
status) (\s :: Job
s@Job' {} Maybe ExecutionStatus
a -> Job
s {$sel:status:Job' :: Maybe ExecutionStatus
status = Maybe ExecutionStatus
a} :: Job)

-- | The job\'s stop time.
job_stopped :: Lens.Lens' Job (Prelude.Maybe Prelude.UTCTime)
job_stopped :: Lens' Job (Maybe UTCTime)
job_stopped = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Job' {Maybe POSIX
stopped :: Maybe POSIX
$sel:stopped:Job' :: Job -> Maybe POSIX
stopped} -> Maybe POSIX
stopped) (\s :: Job
s@Job' {} Maybe POSIX
a -> Job
s {$sel:stopped:Job' :: Maybe POSIX
stopped = Maybe POSIX
a} :: Job) 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 job\'s type.
--
-- Allowed values include the following:
--
-- -   BUILTIN_FUZZ
--
-- -   BUILTIN_EXPLORER. For Android, an app explorer that traverses an
--     Android app, interacting with it and capturing screenshots at the
--     same time.
--
-- -   APPIUM_JAVA_JUNIT
--
-- -   APPIUM_JAVA_TESTNG
--
-- -   APPIUM_PYTHON
--
-- -   APPIUM_NODE
--
-- -   APPIUM_RUBY
--
-- -   APPIUM_WEB_JAVA_JUNIT
--
-- -   APPIUM_WEB_JAVA_TESTNG
--
-- -   APPIUM_WEB_PYTHON
--
-- -   APPIUM_WEB_NODE
--
-- -   APPIUM_WEB_RUBY
--
-- -   CALABASH
--
-- -   INSTRUMENTATION
--
-- -   UIAUTOMATION
--
-- -   UIAUTOMATOR
--
-- -   XCTEST
--
-- -   XCTEST_UI
job_type :: Lens.Lens' Job (Prelude.Maybe TestType)
job_type :: Lens' Job (Maybe TestType)
job_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Job' {Maybe TestType
type' :: Maybe TestType
$sel:type':Job' :: Job -> Maybe TestType
type'} -> Maybe TestType
type') (\s :: Job
s@Job' {} Maybe TestType
a -> Job
s {$sel:type':Job' :: Maybe TestType
type' = Maybe TestType
a} :: Job)

-- | This value is set to true if video capture is enabled. Otherwise, it is
-- set to false.
job_videoCapture :: Lens.Lens' Job (Prelude.Maybe Prelude.Bool)
job_videoCapture :: Lens' Job (Maybe Bool)
job_videoCapture = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Job' {Maybe Bool
videoCapture :: Maybe Bool
$sel:videoCapture:Job' :: Job -> Maybe Bool
videoCapture} -> Maybe Bool
videoCapture) (\s :: Job
s@Job' {} Maybe Bool
a -> Job
s {$sel:videoCapture:Job' :: Maybe Bool
videoCapture = Maybe Bool
a} :: Job)

-- | The endpoint for streaming device video.
job_videoEndpoint :: Lens.Lens' Job (Prelude.Maybe Prelude.Text)
job_videoEndpoint :: Lens' Job (Maybe Text)
job_videoEndpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Job' {Maybe Text
videoEndpoint :: Maybe Text
$sel:videoEndpoint:Job' :: Job -> Maybe Text
videoEndpoint} -> Maybe Text
videoEndpoint) (\s :: Job
s@Job' {} Maybe Text
a -> Job
s {$sel:videoEndpoint:Job' :: Maybe Text
videoEndpoint = Maybe Text
a} :: Job)

instance Data.FromJSON Job where
  parseJSON :: Value -> Parser Job
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Job"
      ( \Object
x ->
          Maybe Text
-> Maybe Counters
-> Maybe POSIX
-> Maybe Device
-> Maybe DeviceMinutes
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe ExecutionResult
-> Maybe POSIX
-> Maybe ExecutionStatus
-> Maybe POSIX
-> Maybe TestType
-> Maybe Bool
-> Maybe Text
-> Job
Job'
            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
"arn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"counters")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"created")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"device")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"deviceMinutes")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"instanceArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"message")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"name")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"result")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"started")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe 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 -> Parser (Maybe a)
Data..:? Key
"stopped")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe 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 (Maybe a)
Data..:? Key
"videoCapture")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"videoEndpoint")
      )

instance Prelude.Hashable Job where
  hashWithSalt :: Int -> Job -> Int
hashWithSalt Int
_salt Job' {Maybe Bool
Maybe Text
Maybe POSIX
Maybe Counters
Maybe DeviceMinutes
Maybe ExecutionResult
Maybe ExecutionStatus
Maybe Device
Maybe TestType
videoEndpoint :: Maybe Text
videoCapture :: Maybe Bool
type' :: Maybe TestType
stopped :: Maybe POSIX
status :: Maybe ExecutionStatus
started :: Maybe POSIX
result :: Maybe ExecutionResult
name :: Maybe Text
message :: Maybe Text
instanceArn :: Maybe Text
deviceMinutes :: Maybe DeviceMinutes
device :: Maybe Device
created :: Maybe POSIX
counters :: Maybe Counters
arn :: Maybe Text
$sel:videoEndpoint:Job' :: Job -> Maybe Text
$sel:videoCapture:Job' :: Job -> Maybe Bool
$sel:type':Job' :: Job -> Maybe TestType
$sel:stopped:Job' :: Job -> Maybe POSIX
$sel:status:Job' :: Job -> Maybe ExecutionStatus
$sel:started:Job' :: Job -> Maybe POSIX
$sel:result:Job' :: Job -> Maybe ExecutionResult
$sel:name:Job' :: Job -> Maybe Text
$sel:message:Job' :: Job -> Maybe Text
$sel:instanceArn:Job' :: Job -> Maybe Text
$sel:deviceMinutes:Job' :: Job -> Maybe DeviceMinutes
$sel:device:Job' :: Job -> Maybe Device
$sel:created:Job' :: Job -> Maybe POSIX
$sel:counters:Job' :: Job -> Maybe Counters
$sel:arn:Job' :: Job -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
arn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Counters
counters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
created
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Device
device
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DeviceMinutes
deviceMinutes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
instanceArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
message
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ExecutionResult
result
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
started
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ExecutionStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
stopped
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TestType
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
videoCapture
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
videoEndpoint

instance Prelude.NFData Job where
  rnf :: Job -> ()
rnf Job' {Maybe Bool
Maybe Text
Maybe POSIX
Maybe Counters
Maybe DeviceMinutes
Maybe ExecutionResult
Maybe ExecutionStatus
Maybe Device
Maybe TestType
videoEndpoint :: Maybe Text
videoCapture :: Maybe Bool
type' :: Maybe TestType
stopped :: Maybe POSIX
status :: Maybe ExecutionStatus
started :: Maybe POSIX
result :: Maybe ExecutionResult
name :: Maybe Text
message :: Maybe Text
instanceArn :: Maybe Text
deviceMinutes :: Maybe DeviceMinutes
device :: Maybe Device
created :: Maybe POSIX
counters :: Maybe Counters
arn :: Maybe Text
$sel:videoEndpoint:Job' :: Job -> Maybe Text
$sel:videoCapture:Job' :: Job -> Maybe Bool
$sel:type':Job' :: Job -> Maybe TestType
$sel:stopped:Job' :: Job -> Maybe POSIX
$sel:status:Job' :: Job -> Maybe ExecutionStatus
$sel:started:Job' :: Job -> Maybe POSIX
$sel:result:Job' :: Job -> Maybe ExecutionResult
$sel:name:Job' :: Job -> Maybe Text
$sel:message:Job' :: Job -> Maybe Text
$sel:instanceArn:Job' :: Job -> Maybe Text
$sel:deviceMinutes:Job' :: Job -> Maybe DeviceMinutes
$sel:device:Job' :: Job -> Maybe Device
$sel:created:Job' :: Job -> Maybe POSIX
$sel:counters:Job' :: Job -> Maybe Counters
$sel:arn:Job' :: Job -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Counters
counters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
created
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Device
device
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DeviceMinutes
deviceMinutes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
instanceArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
message
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ExecutionResult
result
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
started
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ExecutionStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
stopped
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TestType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
videoCapture
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
videoEndpoint