{-# 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.Run
-- 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.Run 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.BillingMethod
import Amazonka.DeviceFarm.Types.Counters
import Amazonka.DeviceFarm.Types.CustomerArtifactPaths
import Amazonka.DeviceFarm.Types.DeviceMinutes
import Amazonka.DeviceFarm.Types.DevicePlatform
import Amazonka.DeviceFarm.Types.DeviceSelectionResult
import Amazonka.DeviceFarm.Types.ExecutionResult
import Amazonka.DeviceFarm.Types.ExecutionResultCode
import Amazonka.DeviceFarm.Types.ExecutionStatus
import Amazonka.DeviceFarm.Types.Location
import Amazonka.DeviceFarm.Types.NetworkProfile
import Amazonka.DeviceFarm.Types.Radios
import Amazonka.DeviceFarm.Types.TestType
import Amazonka.DeviceFarm.Types.VpcConfig
import qualified Amazonka.Prelude as Prelude

-- | Represents a test run on a set of devices with a given app package, test
-- parameters, and so on.
--
-- /See:/ 'newRun' smart constructor.
data Run = Run'
  { -- | An app to upload or that has been uploaded.
    Run -> Maybe Text
appUpload :: Prelude.Maybe Prelude.Text,
    -- | The run\'s ARN.
    Run -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | Specifies the billing method for a test run: @metered@ or @unmetered@.
    -- If the parameter is not specified, the default value is @metered@.
    --
    -- If you have unmetered device slots, you must set this to @unmetered@ to
    -- use them. Otherwise, the run is counted toward metered device minutes.
    Run -> Maybe BillingMethod
billingMethod :: Prelude.Maybe BillingMethod,
    -- | The total number of completed jobs.
    Run -> Maybe Int
completedJobs :: Prelude.Maybe Prelude.Int,
    -- | The run\'s result counters.
    Run -> Maybe Counters
counters :: Prelude.Maybe Counters,
    -- | When the run was created.
    Run -> Maybe POSIX
created :: Prelude.Maybe Data.POSIX,
    -- | Output @CustomerArtifactPaths@ object for the test run.
    Run -> Maybe CustomerArtifactPaths
customerArtifactPaths :: Prelude.Maybe CustomerArtifactPaths,
    -- | Represents the total (metered or unmetered) minutes used by the test
    -- run.
    Run -> Maybe DeviceMinutes
deviceMinutes :: Prelude.Maybe DeviceMinutes,
    -- | The ARN of the device pool for the run.
    Run -> Maybe Text
devicePoolArn :: Prelude.Maybe Prelude.Text,
    -- | The results of a device filter used to select the devices for a test
    -- run.
    Run -> Maybe DeviceSelectionResult
deviceSelectionResult :: Prelude.Maybe DeviceSelectionResult,
    -- | For fuzz tests, this is the number of events, between 1 and 10000, that
    -- the UI fuzz test should perform.
    Run -> Maybe Int
eventCount :: Prelude.Maybe Prelude.Int,
    -- | The number of minutes the job executes before it times out.
    Run -> Maybe Int
jobTimeoutMinutes :: Prelude.Maybe Prelude.Int,
    -- | Information about the locale that is used for the run.
    Run -> Maybe Text
locale :: Prelude.Maybe Prelude.Text,
    -- | Information about the location that is used for the run.
    Run -> Maybe Location
location :: Prelude.Maybe Location,
    -- | A message about the run\'s result.
    Run -> Maybe Text
message :: Prelude.Maybe Prelude.Text,
    -- | The run\'s name.
    Run -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The network profile being used for a test run.
    Run -> Maybe NetworkProfile
networkProfile :: Prelude.Maybe NetworkProfile,
    -- | Read-only URL for an object in an S3 bucket where you can get the
    -- parsing results of the test package. If the test package doesn\'t parse,
    -- the reason why it doesn\'t parse appears in the file that this URL
    -- points to.
    Run -> Maybe Text
parsingResultUrl :: Prelude.Maybe Prelude.Text,
    -- | The run\'s platform.
    --
    -- Allowed values include:
    --
    -- -   ANDROID
    --
    -- -   IOS
    Run -> Maybe DevicePlatform
platform :: Prelude.Maybe DevicePlatform,
    -- | Information about the radio states for the run.
    Run -> Maybe Radios
radios :: Prelude.Maybe Radios,
    -- | The run\'s result.
    --
    -- Allowed values include:
    --
    -- -   PENDING
    --
    -- -   PASSED
    --
    -- -   WARNED
    --
    -- -   FAILED
    --
    -- -   SKIPPED
    --
    -- -   ERRORED
    --
    -- -   STOPPED
    Run -> Maybe ExecutionResult
result :: Prelude.Maybe ExecutionResult,
    -- | Supporting field for the result field. Set only if @result@ is
    -- @SKIPPED@. @PARSING_FAILED@ if the result is skipped because of test
    -- package parsing failure.
    Run -> Maybe ExecutionResultCode
resultCode :: Prelude.Maybe ExecutionResultCode,
    -- | For fuzz tests, this is a seed to use for randomizing the UI fuzz test.
    -- Using the same seed value between tests ensures identical event
    -- sequences.
    Run -> Maybe Int
seed :: Prelude.Maybe Prelude.Int,
    -- | When set to @true@, for private devices, Device Farm does not sign your
    -- app again. For public devices, Device Farm always signs your apps again.
    --
    -- For more information about how Device Farm re-signs your apps, see
    -- <http://aws.amazon.com/device-farm/faqs/ Do you modify my app?> in the
    -- /AWS Device Farm FAQs/.
    Run -> Maybe Bool
skipAppResign :: Prelude.Maybe Prelude.Bool,
    -- | The run\'s start time.
    Run -> Maybe POSIX
started :: Prelude.Maybe Data.POSIX,
    -- | The run\'s status.
    --
    -- Allowed values include:
    --
    -- -   PENDING
    --
    -- -   PENDING_CONCURRENCY
    --
    -- -   PENDING_DEVICE
    --
    -- -   PROCESSING
    --
    -- -   SCHEDULING
    --
    -- -   PREPARING
    --
    -- -   RUNNING
    --
    -- -   COMPLETED
    --
    -- -   STOPPING
    Run -> Maybe ExecutionStatus
status :: Prelude.Maybe ExecutionStatus,
    -- | The run\'s stop time.
    Run -> Maybe POSIX
stopped :: Prelude.Maybe Data.POSIX,
    -- | The ARN of the YAML-formatted test specification for the run.
    Run -> Maybe Text
testSpecArn :: Prelude.Maybe Prelude.Text,
    -- | The total number of jobs for the run.
    Run -> Maybe Int
totalJobs :: Prelude.Maybe Prelude.Int,
    -- | The run\'s type.
    --
    -- Must be one of the following values:
    --
    -- -   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
    Run -> Maybe TestType
type' :: Prelude.Maybe TestType,
    -- | The VPC security groups and subnets that are attached to a project.
    Run -> Maybe VpcConfig
vpcConfig :: Prelude.Maybe VpcConfig,
    -- | The Device Farm console URL for the recording of the run.
    Run -> Maybe Text
webUrl :: Prelude.Maybe Prelude.Text
  }
  deriving (Run -> Run -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Run -> Run -> Bool
$c/= :: Run -> Run -> Bool
== :: Run -> Run -> Bool
$c== :: Run -> Run -> Bool
Prelude.Eq, ReadPrec [Run]
ReadPrec Run
Int -> ReadS Run
ReadS [Run]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Run]
$creadListPrec :: ReadPrec [Run]
readPrec :: ReadPrec Run
$creadPrec :: ReadPrec Run
readList :: ReadS [Run]
$creadList :: ReadS [Run]
readsPrec :: Int -> ReadS Run
$creadsPrec :: Int -> ReadS Run
Prelude.Read, Int -> Run -> ShowS
[Run] -> ShowS
Run -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Run] -> ShowS
$cshowList :: [Run] -> ShowS
show :: Run -> String
$cshow :: Run -> String
showsPrec :: Int -> Run -> ShowS
$cshowsPrec :: Int -> Run -> ShowS
Prelude.Show, forall x. Rep Run x -> Run
forall x. Run -> Rep Run x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Run x -> Run
$cfrom :: forall x. Run -> Rep Run x
Prelude.Generic)

-- |
-- Create a value of 'Run' 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:
--
-- 'appUpload', 'run_appUpload' - An app to upload or that has been uploaded.
--
-- 'arn', 'run_arn' - The run\'s ARN.
--
-- 'billingMethod', 'run_billingMethod' - Specifies the billing method for a test run: @metered@ or @unmetered@.
-- If the parameter is not specified, the default value is @metered@.
--
-- If you have unmetered device slots, you must set this to @unmetered@ to
-- use them. Otherwise, the run is counted toward metered device minutes.
--
-- 'completedJobs', 'run_completedJobs' - The total number of completed jobs.
--
-- 'counters', 'run_counters' - The run\'s result counters.
--
-- 'created', 'run_created' - When the run was created.
--
-- 'customerArtifactPaths', 'run_customerArtifactPaths' - Output @CustomerArtifactPaths@ object for the test run.
--
-- 'deviceMinutes', 'run_deviceMinutes' - Represents the total (metered or unmetered) minutes used by the test
-- run.
--
-- 'devicePoolArn', 'run_devicePoolArn' - The ARN of the device pool for the run.
--
-- 'deviceSelectionResult', 'run_deviceSelectionResult' - The results of a device filter used to select the devices for a test
-- run.
--
-- 'eventCount', 'run_eventCount' - For fuzz tests, this is the number of events, between 1 and 10000, that
-- the UI fuzz test should perform.
--
-- 'jobTimeoutMinutes', 'run_jobTimeoutMinutes' - The number of minutes the job executes before it times out.
--
-- 'locale', 'run_locale' - Information about the locale that is used for the run.
--
-- 'location', 'run_location' - Information about the location that is used for the run.
--
-- 'message', 'run_message' - A message about the run\'s result.
--
-- 'name', 'run_name' - The run\'s name.
--
-- 'networkProfile', 'run_networkProfile' - The network profile being used for a test run.
--
-- 'parsingResultUrl', 'run_parsingResultUrl' - Read-only URL for an object in an S3 bucket where you can get the
-- parsing results of the test package. If the test package doesn\'t parse,
-- the reason why it doesn\'t parse appears in the file that this URL
-- points to.
--
-- 'platform', 'run_platform' - The run\'s platform.
--
-- Allowed values include:
--
-- -   ANDROID
--
-- -   IOS
--
-- 'radios', 'run_radios' - Information about the radio states for the run.
--
-- 'result', 'run_result' - The run\'s result.
--
-- Allowed values include:
--
-- -   PENDING
--
-- -   PASSED
--
-- -   WARNED
--
-- -   FAILED
--
-- -   SKIPPED
--
-- -   ERRORED
--
-- -   STOPPED
--
-- 'resultCode', 'run_resultCode' - Supporting field for the result field. Set only if @result@ is
-- @SKIPPED@. @PARSING_FAILED@ if the result is skipped because of test
-- package parsing failure.
--
-- 'seed', 'run_seed' - For fuzz tests, this is a seed to use for randomizing the UI fuzz test.
-- Using the same seed value between tests ensures identical event
-- sequences.
--
-- 'skipAppResign', 'run_skipAppResign' - When set to @true@, for private devices, Device Farm does not sign your
-- app again. For public devices, Device Farm always signs your apps again.
--
-- For more information about how Device Farm re-signs your apps, see
-- <http://aws.amazon.com/device-farm/faqs/ Do you modify my app?> in the
-- /AWS Device Farm FAQs/.
--
-- 'started', 'run_started' - The run\'s start time.
--
-- 'status', 'run_status' - The run\'s status.
--
-- Allowed values include:
--
-- -   PENDING
--
-- -   PENDING_CONCURRENCY
--
-- -   PENDING_DEVICE
--
-- -   PROCESSING
--
-- -   SCHEDULING
--
-- -   PREPARING
--
-- -   RUNNING
--
-- -   COMPLETED
--
-- -   STOPPING
--
-- 'stopped', 'run_stopped' - The run\'s stop time.
--
-- 'testSpecArn', 'run_testSpecArn' - The ARN of the YAML-formatted test specification for the run.
--
-- 'totalJobs', 'run_totalJobs' - The total number of jobs for the run.
--
-- 'type'', 'run_type' - The run\'s type.
--
-- Must be one of the following values:
--
-- -   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
--
-- 'vpcConfig', 'run_vpcConfig' - The VPC security groups and subnets that are attached to a project.
--
-- 'webUrl', 'run_webUrl' - The Device Farm console URL for the recording of the run.
newRun ::
  Run
newRun :: Run
newRun =
  Run'
    { $sel:appUpload:Run' :: Maybe Text
appUpload = forall a. Maybe a
Prelude.Nothing,
      $sel:arn:Run' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:billingMethod:Run' :: Maybe BillingMethod
billingMethod = forall a. Maybe a
Prelude.Nothing,
      $sel:completedJobs:Run' :: Maybe Int
completedJobs = forall a. Maybe a
Prelude.Nothing,
      $sel:counters:Run' :: Maybe Counters
counters = forall a. Maybe a
Prelude.Nothing,
      $sel:created:Run' :: Maybe POSIX
created = forall a. Maybe a
Prelude.Nothing,
      $sel:customerArtifactPaths:Run' :: Maybe CustomerArtifactPaths
customerArtifactPaths = forall a. Maybe a
Prelude.Nothing,
      $sel:deviceMinutes:Run' :: Maybe DeviceMinutes
deviceMinutes = forall a. Maybe a
Prelude.Nothing,
      $sel:devicePoolArn:Run' :: Maybe Text
devicePoolArn = forall a. Maybe a
Prelude.Nothing,
      $sel:deviceSelectionResult:Run' :: Maybe DeviceSelectionResult
deviceSelectionResult = forall a. Maybe a
Prelude.Nothing,
      $sel:eventCount:Run' :: Maybe Int
eventCount = forall a. Maybe a
Prelude.Nothing,
      $sel:jobTimeoutMinutes:Run' :: Maybe Int
jobTimeoutMinutes = forall a. Maybe a
Prelude.Nothing,
      $sel:locale:Run' :: Maybe Text
locale = forall a. Maybe a
Prelude.Nothing,
      $sel:location:Run' :: Maybe Location
location = forall a. Maybe a
Prelude.Nothing,
      $sel:message:Run' :: Maybe Text
message = forall a. Maybe a
Prelude.Nothing,
      $sel:name:Run' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:networkProfile:Run' :: Maybe NetworkProfile
networkProfile = forall a. Maybe a
Prelude.Nothing,
      $sel:parsingResultUrl:Run' :: Maybe Text
parsingResultUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:platform:Run' :: Maybe DevicePlatform
platform = forall a. Maybe a
Prelude.Nothing,
      $sel:radios:Run' :: Maybe Radios
radios = forall a. Maybe a
Prelude.Nothing,
      $sel:result:Run' :: Maybe ExecutionResult
result = forall a. Maybe a
Prelude.Nothing,
      $sel:resultCode:Run' :: Maybe ExecutionResultCode
resultCode = forall a. Maybe a
Prelude.Nothing,
      $sel:seed:Run' :: Maybe Int
seed = forall a. Maybe a
Prelude.Nothing,
      $sel:skipAppResign:Run' :: Maybe Bool
skipAppResign = forall a. Maybe a
Prelude.Nothing,
      $sel:started:Run' :: Maybe POSIX
started = forall a. Maybe a
Prelude.Nothing,
      $sel:status:Run' :: Maybe ExecutionStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:stopped:Run' :: Maybe POSIX
stopped = forall a. Maybe a
Prelude.Nothing,
      $sel:testSpecArn:Run' :: Maybe Text
testSpecArn = forall a. Maybe a
Prelude.Nothing,
      $sel:totalJobs:Run' :: Maybe Int
totalJobs = forall a. Maybe a
Prelude.Nothing,
      $sel:type':Run' :: Maybe TestType
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcConfig:Run' :: Maybe VpcConfig
vpcConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:webUrl:Run' :: Maybe Text
webUrl = forall a. Maybe a
Prelude.Nothing
    }

-- | An app to upload or that has been uploaded.
run_appUpload :: Lens.Lens' Run (Prelude.Maybe Prelude.Text)
run_appUpload :: Lens' Run (Maybe Text)
run_appUpload = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Run' {Maybe Text
appUpload :: Maybe Text
$sel:appUpload:Run' :: Run -> Maybe Text
appUpload} -> Maybe Text
appUpload) (\s :: Run
s@Run' {} Maybe Text
a -> Run
s {$sel:appUpload:Run' :: Maybe Text
appUpload = Maybe Text
a} :: Run)

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

-- | Specifies the billing method for a test run: @metered@ or @unmetered@.
-- If the parameter is not specified, the default value is @metered@.
--
-- If you have unmetered device slots, you must set this to @unmetered@ to
-- use them. Otherwise, the run is counted toward metered device minutes.
run_billingMethod :: Lens.Lens' Run (Prelude.Maybe BillingMethod)
run_billingMethod :: Lens' Run (Maybe BillingMethod)
run_billingMethod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Run' {Maybe BillingMethod
billingMethod :: Maybe BillingMethod
$sel:billingMethod:Run' :: Run -> Maybe BillingMethod
billingMethod} -> Maybe BillingMethod
billingMethod) (\s :: Run
s@Run' {} Maybe BillingMethod
a -> Run
s {$sel:billingMethod:Run' :: Maybe BillingMethod
billingMethod = Maybe BillingMethod
a} :: Run)

-- | The total number of completed jobs.
run_completedJobs :: Lens.Lens' Run (Prelude.Maybe Prelude.Int)
run_completedJobs :: Lens' Run (Maybe Int)
run_completedJobs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Run' {Maybe Int
completedJobs :: Maybe Int
$sel:completedJobs:Run' :: Run -> Maybe Int
completedJobs} -> Maybe Int
completedJobs) (\s :: Run
s@Run' {} Maybe Int
a -> Run
s {$sel:completedJobs:Run' :: Maybe Int
completedJobs = Maybe Int
a} :: Run)

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

-- | When the run was created.
run_created :: Lens.Lens' Run (Prelude.Maybe Prelude.UTCTime)
run_created :: Lens' Run (Maybe UTCTime)
run_created = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Run' {Maybe POSIX
created :: Maybe POSIX
$sel:created:Run' :: Run -> Maybe POSIX
created} -> Maybe POSIX
created) (\s :: Run
s@Run' {} Maybe POSIX
a -> Run
s {$sel:created:Run' :: Maybe POSIX
created = Maybe POSIX
a} :: Run) 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

-- | Output @CustomerArtifactPaths@ object for the test run.
run_customerArtifactPaths :: Lens.Lens' Run (Prelude.Maybe CustomerArtifactPaths)
run_customerArtifactPaths :: Lens' Run (Maybe CustomerArtifactPaths)
run_customerArtifactPaths = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Run' {Maybe CustomerArtifactPaths
customerArtifactPaths :: Maybe CustomerArtifactPaths
$sel:customerArtifactPaths:Run' :: Run -> Maybe CustomerArtifactPaths
customerArtifactPaths} -> Maybe CustomerArtifactPaths
customerArtifactPaths) (\s :: Run
s@Run' {} Maybe CustomerArtifactPaths
a -> Run
s {$sel:customerArtifactPaths:Run' :: Maybe CustomerArtifactPaths
customerArtifactPaths = Maybe CustomerArtifactPaths
a} :: Run)

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

-- | The ARN of the device pool for the run.
run_devicePoolArn :: Lens.Lens' Run (Prelude.Maybe Prelude.Text)
run_devicePoolArn :: Lens' Run (Maybe Text)
run_devicePoolArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Run' {Maybe Text
devicePoolArn :: Maybe Text
$sel:devicePoolArn:Run' :: Run -> Maybe Text
devicePoolArn} -> Maybe Text
devicePoolArn) (\s :: Run
s@Run' {} Maybe Text
a -> Run
s {$sel:devicePoolArn:Run' :: Maybe Text
devicePoolArn = Maybe Text
a} :: Run)

-- | The results of a device filter used to select the devices for a test
-- run.
run_deviceSelectionResult :: Lens.Lens' Run (Prelude.Maybe DeviceSelectionResult)
run_deviceSelectionResult :: Lens' Run (Maybe DeviceSelectionResult)
run_deviceSelectionResult = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Run' {Maybe DeviceSelectionResult
deviceSelectionResult :: Maybe DeviceSelectionResult
$sel:deviceSelectionResult:Run' :: Run -> Maybe DeviceSelectionResult
deviceSelectionResult} -> Maybe DeviceSelectionResult
deviceSelectionResult) (\s :: Run
s@Run' {} Maybe DeviceSelectionResult
a -> Run
s {$sel:deviceSelectionResult:Run' :: Maybe DeviceSelectionResult
deviceSelectionResult = Maybe DeviceSelectionResult
a} :: Run)

-- | For fuzz tests, this is the number of events, between 1 and 10000, that
-- the UI fuzz test should perform.
run_eventCount :: Lens.Lens' Run (Prelude.Maybe Prelude.Int)
run_eventCount :: Lens' Run (Maybe Int)
run_eventCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Run' {Maybe Int
eventCount :: Maybe Int
$sel:eventCount:Run' :: Run -> Maybe Int
eventCount} -> Maybe Int
eventCount) (\s :: Run
s@Run' {} Maybe Int
a -> Run
s {$sel:eventCount:Run' :: Maybe Int
eventCount = Maybe Int
a} :: Run)

-- | The number of minutes the job executes before it times out.
run_jobTimeoutMinutes :: Lens.Lens' Run (Prelude.Maybe Prelude.Int)
run_jobTimeoutMinutes :: Lens' Run (Maybe Int)
run_jobTimeoutMinutes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Run' {Maybe Int
jobTimeoutMinutes :: Maybe Int
$sel:jobTimeoutMinutes:Run' :: Run -> Maybe Int
jobTimeoutMinutes} -> Maybe Int
jobTimeoutMinutes) (\s :: Run
s@Run' {} Maybe Int
a -> Run
s {$sel:jobTimeoutMinutes:Run' :: Maybe Int
jobTimeoutMinutes = Maybe Int
a} :: Run)

-- | Information about the locale that is used for the run.
run_locale :: Lens.Lens' Run (Prelude.Maybe Prelude.Text)
run_locale :: Lens' Run (Maybe Text)
run_locale = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Run' {Maybe Text
locale :: Maybe Text
$sel:locale:Run' :: Run -> Maybe Text
locale} -> Maybe Text
locale) (\s :: Run
s@Run' {} Maybe Text
a -> Run
s {$sel:locale:Run' :: Maybe Text
locale = Maybe Text
a} :: Run)

-- | Information about the location that is used for the run.
run_location :: Lens.Lens' Run (Prelude.Maybe Location)
run_location :: Lens' Run (Maybe Location)
run_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Run' {Maybe Location
location :: Maybe Location
$sel:location:Run' :: Run -> Maybe Location
location} -> Maybe Location
location) (\s :: Run
s@Run' {} Maybe Location
a -> Run
s {$sel:location:Run' :: Maybe Location
location = Maybe Location
a} :: Run)

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

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

-- | The network profile being used for a test run.
run_networkProfile :: Lens.Lens' Run (Prelude.Maybe NetworkProfile)
run_networkProfile :: Lens' Run (Maybe NetworkProfile)
run_networkProfile = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Run' {Maybe NetworkProfile
networkProfile :: Maybe NetworkProfile
$sel:networkProfile:Run' :: Run -> Maybe NetworkProfile
networkProfile} -> Maybe NetworkProfile
networkProfile) (\s :: Run
s@Run' {} Maybe NetworkProfile
a -> Run
s {$sel:networkProfile:Run' :: Maybe NetworkProfile
networkProfile = Maybe NetworkProfile
a} :: Run)

-- | Read-only URL for an object in an S3 bucket where you can get the
-- parsing results of the test package. If the test package doesn\'t parse,
-- the reason why it doesn\'t parse appears in the file that this URL
-- points to.
run_parsingResultUrl :: Lens.Lens' Run (Prelude.Maybe Prelude.Text)
run_parsingResultUrl :: Lens' Run (Maybe Text)
run_parsingResultUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Run' {Maybe Text
parsingResultUrl :: Maybe Text
$sel:parsingResultUrl:Run' :: Run -> Maybe Text
parsingResultUrl} -> Maybe Text
parsingResultUrl) (\s :: Run
s@Run' {} Maybe Text
a -> Run
s {$sel:parsingResultUrl:Run' :: Maybe Text
parsingResultUrl = Maybe Text
a} :: Run)

-- | The run\'s platform.
--
-- Allowed values include:
--
-- -   ANDROID
--
-- -   IOS
run_platform :: Lens.Lens' Run (Prelude.Maybe DevicePlatform)
run_platform :: Lens' Run (Maybe DevicePlatform)
run_platform = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Run' {Maybe DevicePlatform
platform :: Maybe DevicePlatform
$sel:platform:Run' :: Run -> Maybe DevicePlatform
platform} -> Maybe DevicePlatform
platform) (\s :: Run
s@Run' {} Maybe DevicePlatform
a -> Run
s {$sel:platform:Run' :: Maybe DevicePlatform
platform = Maybe DevicePlatform
a} :: Run)

-- | Information about the radio states for the run.
run_radios :: Lens.Lens' Run (Prelude.Maybe Radios)
run_radios :: Lens' Run (Maybe Radios)
run_radios = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Run' {Maybe Radios
radios :: Maybe Radios
$sel:radios:Run' :: Run -> Maybe Radios
radios} -> Maybe Radios
radios) (\s :: Run
s@Run' {} Maybe Radios
a -> Run
s {$sel:radios:Run' :: Maybe Radios
radios = Maybe Radios
a} :: Run)

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

-- | Supporting field for the result field. Set only if @result@ is
-- @SKIPPED@. @PARSING_FAILED@ if the result is skipped because of test
-- package parsing failure.
run_resultCode :: Lens.Lens' Run (Prelude.Maybe ExecutionResultCode)
run_resultCode :: Lens' Run (Maybe ExecutionResultCode)
run_resultCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Run' {Maybe ExecutionResultCode
resultCode :: Maybe ExecutionResultCode
$sel:resultCode:Run' :: Run -> Maybe ExecutionResultCode
resultCode} -> Maybe ExecutionResultCode
resultCode) (\s :: Run
s@Run' {} Maybe ExecutionResultCode
a -> Run
s {$sel:resultCode:Run' :: Maybe ExecutionResultCode
resultCode = Maybe ExecutionResultCode
a} :: Run)

-- | For fuzz tests, this is a seed to use for randomizing the UI fuzz test.
-- Using the same seed value between tests ensures identical event
-- sequences.
run_seed :: Lens.Lens' Run (Prelude.Maybe Prelude.Int)
run_seed :: Lens' Run (Maybe Int)
run_seed = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Run' {Maybe Int
seed :: Maybe Int
$sel:seed:Run' :: Run -> Maybe Int
seed} -> Maybe Int
seed) (\s :: Run
s@Run' {} Maybe Int
a -> Run
s {$sel:seed:Run' :: Maybe Int
seed = Maybe Int
a} :: Run)

-- | When set to @true@, for private devices, Device Farm does not sign your
-- app again. For public devices, Device Farm always signs your apps again.
--
-- For more information about how Device Farm re-signs your apps, see
-- <http://aws.amazon.com/device-farm/faqs/ Do you modify my app?> in the
-- /AWS Device Farm FAQs/.
run_skipAppResign :: Lens.Lens' Run (Prelude.Maybe Prelude.Bool)
run_skipAppResign :: Lens' Run (Maybe Bool)
run_skipAppResign = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Run' {Maybe Bool
skipAppResign :: Maybe Bool
$sel:skipAppResign:Run' :: Run -> Maybe Bool
skipAppResign} -> Maybe Bool
skipAppResign) (\s :: Run
s@Run' {} Maybe Bool
a -> Run
s {$sel:skipAppResign:Run' :: Maybe Bool
skipAppResign = Maybe Bool
a} :: Run)

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

-- | The run\'s stop time.
run_stopped :: Lens.Lens' Run (Prelude.Maybe Prelude.UTCTime)
run_stopped :: Lens' Run (Maybe UTCTime)
run_stopped = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Run' {Maybe POSIX
stopped :: Maybe POSIX
$sel:stopped:Run' :: Run -> Maybe POSIX
stopped} -> Maybe POSIX
stopped) (\s :: Run
s@Run' {} Maybe POSIX
a -> Run
s {$sel:stopped:Run' :: Maybe POSIX
stopped = Maybe POSIX
a} :: Run) 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 ARN of the YAML-formatted test specification for the run.
run_testSpecArn :: Lens.Lens' Run (Prelude.Maybe Prelude.Text)
run_testSpecArn :: Lens' Run (Maybe Text)
run_testSpecArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Run' {Maybe Text
testSpecArn :: Maybe Text
$sel:testSpecArn:Run' :: Run -> Maybe Text
testSpecArn} -> Maybe Text
testSpecArn) (\s :: Run
s@Run' {} Maybe Text
a -> Run
s {$sel:testSpecArn:Run' :: Maybe Text
testSpecArn = Maybe Text
a} :: Run)

-- | The total number of jobs for the run.
run_totalJobs :: Lens.Lens' Run (Prelude.Maybe Prelude.Int)
run_totalJobs :: Lens' Run (Maybe Int)
run_totalJobs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Run' {Maybe Int
totalJobs :: Maybe Int
$sel:totalJobs:Run' :: Run -> Maybe Int
totalJobs} -> Maybe Int
totalJobs) (\s :: Run
s@Run' {} Maybe Int
a -> Run
s {$sel:totalJobs:Run' :: Maybe Int
totalJobs = Maybe Int
a} :: Run)

-- | The run\'s type.
--
-- Must be one of the following values:
--
-- -   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
run_type :: Lens.Lens' Run (Prelude.Maybe TestType)
run_type :: Lens' Run (Maybe TestType)
run_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Run' {Maybe TestType
type' :: Maybe TestType
$sel:type':Run' :: Run -> Maybe TestType
type'} -> Maybe TestType
type') (\s :: Run
s@Run' {} Maybe TestType
a -> Run
s {$sel:type':Run' :: Maybe TestType
type' = Maybe TestType
a} :: Run)

-- | The VPC security groups and subnets that are attached to a project.
run_vpcConfig :: Lens.Lens' Run (Prelude.Maybe VpcConfig)
run_vpcConfig :: Lens' Run (Maybe VpcConfig)
run_vpcConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Run' {Maybe VpcConfig
vpcConfig :: Maybe VpcConfig
$sel:vpcConfig:Run' :: Run -> Maybe VpcConfig
vpcConfig} -> Maybe VpcConfig
vpcConfig) (\s :: Run
s@Run' {} Maybe VpcConfig
a -> Run
s {$sel:vpcConfig:Run' :: Maybe VpcConfig
vpcConfig = Maybe VpcConfig
a} :: Run)

-- | The Device Farm console URL for the recording of the run.
run_webUrl :: Lens.Lens' Run (Prelude.Maybe Prelude.Text)
run_webUrl :: Lens' Run (Maybe Text)
run_webUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Run' {Maybe Text
webUrl :: Maybe Text
$sel:webUrl:Run' :: Run -> Maybe Text
webUrl} -> Maybe Text
webUrl) (\s :: Run
s@Run' {} Maybe Text
a -> Run
s {$sel:webUrl:Run' :: Maybe Text
webUrl = Maybe Text
a} :: Run)

instance Data.FromJSON Run where
  parseJSON :: Value -> Parser Run
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Run"
      ( \Object
x ->
          Maybe Text
-> Maybe Text
-> Maybe BillingMethod
-> Maybe Int
-> Maybe Counters
-> Maybe POSIX
-> Maybe CustomerArtifactPaths
-> Maybe DeviceMinutes
-> Maybe Text
-> Maybe DeviceSelectionResult
-> Maybe Int
-> Maybe Int
-> Maybe Text
-> Maybe Location
-> Maybe Text
-> Maybe Text
-> Maybe NetworkProfile
-> Maybe Text
-> Maybe DevicePlatform
-> Maybe Radios
-> Maybe ExecutionResult
-> Maybe ExecutionResultCode
-> Maybe Int
-> Maybe Bool
-> Maybe POSIX
-> Maybe ExecutionStatus
-> Maybe POSIX
-> Maybe Text
-> Maybe Int
-> Maybe TestType
-> Maybe VpcConfig
-> Maybe Text
-> Run
Run'
            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
"appUpload")
            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
"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
"billingMethod")
            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
"completedJobs")
            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
"customerArtifactPaths")
            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
"devicePoolArn")
            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
"deviceSelectionResult")
            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
"eventCount")
            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
"jobTimeoutMinutes")
            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
"locale")
            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
"location")
            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
"networkProfile")
            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
"parsingResultUrl")
            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
"platform")
            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
"radios")
            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
"resultCode")
            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
"seed")
            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
"skipAppResign")
            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
"testSpecArn")
            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
"totalJobs")
            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
"vpcConfig")
            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
"webUrl")
      )

instance Prelude.Hashable Run where
  hashWithSalt :: Int -> Run -> Int
hashWithSalt Int
_salt Run' {Maybe Bool
Maybe Int
Maybe Text
Maybe POSIX
Maybe BillingMethod
Maybe Counters
Maybe CustomerArtifactPaths
Maybe DeviceMinutes
Maybe DevicePlatform
Maybe ExecutionResult
Maybe ExecutionResultCode
Maybe ExecutionStatus
Maybe Location
Maybe NetworkProfile
Maybe Radios
Maybe DeviceSelectionResult
Maybe TestType
Maybe VpcConfig
webUrl :: Maybe Text
vpcConfig :: Maybe VpcConfig
type' :: Maybe TestType
totalJobs :: Maybe Int
testSpecArn :: Maybe Text
stopped :: Maybe POSIX
status :: Maybe ExecutionStatus
started :: Maybe POSIX
skipAppResign :: Maybe Bool
seed :: Maybe Int
resultCode :: Maybe ExecutionResultCode
result :: Maybe ExecutionResult
radios :: Maybe Radios
platform :: Maybe DevicePlatform
parsingResultUrl :: Maybe Text
networkProfile :: Maybe NetworkProfile
name :: Maybe Text
message :: Maybe Text
location :: Maybe Location
locale :: Maybe Text
jobTimeoutMinutes :: Maybe Int
eventCount :: Maybe Int
deviceSelectionResult :: Maybe DeviceSelectionResult
devicePoolArn :: Maybe Text
deviceMinutes :: Maybe DeviceMinutes
customerArtifactPaths :: Maybe CustomerArtifactPaths
created :: Maybe POSIX
counters :: Maybe Counters
completedJobs :: Maybe Int
billingMethod :: Maybe BillingMethod
arn :: Maybe Text
appUpload :: Maybe Text
$sel:webUrl:Run' :: Run -> Maybe Text
$sel:vpcConfig:Run' :: Run -> Maybe VpcConfig
$sel:type':Run' :: Run -> Maybe TestType
$sel:totalJobs:Run' :: Run -> Maybe Int
$sel:testSpecArn:Run' :: Run -> Maybe Text
$sel:stopped:Run' :: Run -> Maybe POSIX
$sel:status:Run' :: Run -> Maybe ExecutionStatus
$sel:started:Run' :: Run -> Maybe POSIX
$sel:skipAppResign:Run' :: Run -> Maybe Bool
$sel:seed:Run' :: Run -> Maybe Int
$sel:resultCode:Run' :: Run -> Maybe ExecutionResultCode
$sel:result:Run' :: Run -> Maybe ExecutionResult
$sel:radios:Run' :: Run -> Maybe Radios
$sel:platform:Run' :: Run -> Maybe DevicePlatform
$sel:parsingResultUrl:Run' :: Run -> Maybe Text
$sel:networkProfile:Run' :: Run -> Maybe NetworkProfile
$sel:name:Run' :: Run -> Maybe Text
$sel:message:Run' :: Run -> Maybe Text
$sel:location:Run' :: Run -> Maybe Location
$sel:locale:Run' :: Run -> Maybe Text
$sel:jobTimeoutMinutes:Run' :: Run -> Maybe Int
$sel:eventCount:Run' :: Run -> Maybe Int
$sel:deviceSelectionResult:Run' :: Run -> Maybe DeviceSelectionResult
$sel:devicePoolArn:Run' :: Run -> Maybe Text
$sel:deviceMinutes:Run' :: Run -> Maybe DeviceMinutes
$sel:customerArtifactPaths:Run' :: Run -> Maybe CustomerArtifactPaths
$sel:created:Run' :: Run -> Maybe POSIX
$sel:counters:Run' :: Run -> Maybe Counters
$sel:completedJobs:Run' :: Run -> Maybe Int
$sel:billingMethod:Run' :: Run -> Maybe BillingMethod
$sel:arn:Run' :: Run -> Maybe Text
$sel:appUpload:Run' :: Run -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
appUpload
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
arn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BillingMethod
billingMethod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
completedJobs
      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 CustomerArtifactPaths
customerArtifactPaths
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DeviceMinutes
deviceMinutes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
devicePoolArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DeviceSelectionResult
deviceSelectionResult
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
eventCount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
jobTimeoutMinutes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
locale
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Location
location
      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 NetworkProfile
networkProfile
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
parsingResultUrl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DevicePlatform
platform
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Radios
radios
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ExecutionResult
result
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ExecutionResultCode
resultCode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
seed
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
skipAppResign
      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 Text
testSpecArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
totalJobs
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TestType
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VpcConfig
vpcConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
webUrl

instance Prelude.NFData Run where
  rnf :: Run -> ()
rnf Run' {Maybe Bool
Maybe Int
Maybe Text
Maybe POSIX
Maybe BillingMethod
Maybe Counters
Maybe CustomerArtifactPaths
Maybe DeviceMinutes
Maybe DevicePlatform
Maybe ExecutionResult
Maybe ExecutionResultCode
Maybe ExecutionStatus
Maybe Location
Maybe NetworkProfile
Maybe Radios
Maybe DeviceSelectionResult
Maybe TestType
Maybe VpcConfig
webUrl :: Maybe Text
vpcConfig :: Maybe VpcConfig
type' :: Maybe TestType
totalJobs :: Maybe Int
testSpecArn :: Maybe Text
stopped :: Maybe POSIX
status :: Maybe ExecutionStatus
started :: Maybe POSIX
skipAppResign :: Maybe Bool
seed :: Maybe Int
resultCode :: Maybe ExecutionResultCode
result :: Maybe ExecutionResult
radios :: Maybe Radios
platform :: Maybe DevicePlatform
parsingResultUrl :: Maybe Text
networkProfile :: Maybe NetworkProfile
name :: Maybe Text
message :: Maybe Text
location :: Maybe Location
locale :: Maybe Text
jobTimeoutMinutes :: Maybe Int
eventCount :: Maybe Int
deviceSelectionResult :: Maybe DeviceSelectionResult
devicePoolArn :: Maybe Text
deviceMinutes :: Maybe DeviceMinutes
customerArtifactPaths :: Maybe CustomerArtifactPaths
created :: Maybe POSIX
counters :: Maybe Counters
completedJobs :: Maybe Int
billingMethod :: Maybe BillingMethod
arn :: Maybe Text
appUpload :: Maybe Text
$sel:webUrl:Run' :: Run -> Maybe Text
$sel:vpcConfig:Run' :: Run -> Maybe VpcConfig
$sel:type':Run' :: Run -> Maybe TestType
$sel:totalJobs:Run' :: Run -> Maybe Int
$sel:testSpecArn:Run' :: Run -> Maybe Text
$sel:stopped:Run' :: Run -> Maybe POSIX
$sel:status:Run' :: Run -> Maybe ExecutionStatus
$sel:started:Run' :: Run -> Maybe POSIX
$sel:skipAppResign:Run' :: Run -> Maybe Bool
$sel:seed:Run' :: Run -> Maybe Int
$sel:resultCode:Run' :: Run -> Maybe ExecutionResultCode
$sel:result:Run' :: Run -> Maybe ExecutionResult
$sel:radios:Run' :: Run -> Maybe Radios
$sel:platform:Run' :: Run -> Maybe DevicePlatform
$sel:parsingResultUrl:Run' :: Run -> Maybe Text
$sel:networkProfile:Run' :: Run -> Maybe NetworkProfile
$sel:name:Run' :: Run -> Maybe Text
$sel:message:Run' :: Run -> Maybe Text
$sel:location:Run' :: Run -> Maybe Location
$sel:locale:Run' :: Run -> Maybe Text
$sel:jobTimeoutMinutes:Run' :: Run -> Maybe Int
$sel:eventCount:Run' :: Run -> Maybe Int
$sel:deviceSelectionResult:Run' :: Run -> Maybe DeviceSelectionResult
$sel:devicePoolArn:Run' :: Run -> Maybe Text
$sel:deviceMinutes:Run' :: Run -> Maybe DeviceMinutes
$sel:customerArtifactPaths:Run' :: Run -> Maybe CustomerArtifactPaths
$sel:created:Run' :: Run -> Maybe POSIX
$sel:counters:Run' :: Run -> Maybe Counters
$sel:completedJobs:Run' :: Run -> Maybe Int
$sel:billingMethod:Run' :: Run -> Maybe BillingMethod
$sel:arn:Run' :: Run -> Maybe Text
$sel:appUpload:Run' :: Run -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
appUpload
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 BillingMethod
billingMethod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
completedJobs
      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 CustomerArtifactPaths
customerArtifactPaths
      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
devicePoolArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DeviceSelectionResult
deviceSelectionResult
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
eventCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
jobTimeoutMinutes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
locale
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Location
location
      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 NetworkProfile
networkProfile
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
parsingResultUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DevicePlatform
platform
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Radios
radios
      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 ExecutionResultCode
resultCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
seed
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Bool
skipAppResign
      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 Text
testSpecArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Int
totalJobs
      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 VpcConfig
vpcConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
webUrl