{-# 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.RemoteAccessSession
-- 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.RemoteAccessSession 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.Device
import Amazonka.DeviceFarm.Types.DeviceMinutes
import Amazonka.DeviceFarm.Types.ExecutionResult
import Amazonka.DeviceFarm.Types.ExecutionStatus
import Amazonka.DeviceFarm.Types.InteractionMode
import Amazonka.DeviceFarm.Types.VpcConfig
import qualified Amazonka.Prelude as Prelude

-- | Represents information about the remote access session.
--
-- /See:/ 'newRemoteAccessSession' smart constructor.
data RemoteAccessSession = RemoteAccessSession'
  { -- | The Amazon Resource Name (ARN) of the remote access session.
    RemoteAccessSession -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The billing method of the remote access session. Possible values include
    -- @METERED@ or @UNMETERED@. For more information about metered devices,
    -- see
    -- <https://docs.aws.amazon.com/devicefarm/latest/developerguide/welcome.html#welcome-terminology AWS Device Farm terminology>.
    RemoteAccessSession -> Maybe BillingMethod
billingMethod :: Prelude.Maybe BillingMethod,
    -- | Unique identifier of your client for the remote access session. Only
    -- returned if remote debugging is enabled for the remote access session.
    --
    -- Remote debugging is
    -- <https://docs.aws.amazon.com/devicefarm/latest/developerguide/history.html no longer supported>.
    RemoteAccessSession -> Maybe Text
clientId :: Prelude.Maybe Prelude.Text,
    -- | The date and time the remote access session was created.
    RemoteAccessSession -> Maybe POSIX
created :: Prelude.Maybe Data.POSIX,
    -- | The device (phone or tablet) used in the remote access session.
    RemoteAccessSession -> Maybe Device
device :: Prelude.Maybe Device,
    -- | The number of minutes a device is used in a remote access session
    -- (including setup and teardown minutes).
    RemoteAccessSession -> Maybe DeviceMinutes
deviceMinutes :: Prelude.Maybe DeviceMinutes,
    -- | Unique device identifier for the remote device. Only returned if remote
    -- debugging is enabled for the remote access session.
    --
    -- Remote debugging is
    -- <https://docs.aws.amazon.com/devicefarm/latest/developerguide/history.html no longer supported>.
    RemoteAccessSession -> Maybe Text
deviceUdid :: Prelude.Maybe Prelude.Text,
    -- | The endpoint for the remote access sesssion.
    RemoteAccessSession -> Maybe Text
endpoint :: Prelude.Maybe Prelude.Text,
    -- | IP address of the EC2 host where you need to connect to remotely debug
    -- devices. Only returned if remote debugging is enabled for the remote
    -- access session.
    --
    -- Remote debugging is
    -- <https://docs.aws.amazon.com/devicefarm/latest/developerguide/history.html no longer supported>.
    RemoteAccessSession -> Maybe Text
hostAddress :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the instance.
    RemoteAccessSession -> Maybe Text
instanceArn :: Prelude.Maybe Prelude.Text,
    -- | The interaction mode of the remote access session. Valid values are:
    --
    -- -   INTERACTIVE: You can interact with the iOS device by viewing,
    --     touching, and rotating the screen. You cannot run XCUITest
    --     framework-based tests in this mode.
    --
    -- -   NO_VIDEO: You are connected to the device, but cannot interact with
    --     it or view the screen. This mode has the fastest test execution
    --     speed. You can run XCUITest framework-based tests in this mode.
    --
    -- -   VIDEO_ONLY: You can view the screen, but cannot touch or rotate it.
    --     You can run XCUITest framework-based tests and watch the screen in
    --     this mode.
    RemoteAccessSession -> Maybe InteractionMode
interactionMode :: Prelude.Maybe InteractionMode,
    -- | A message about the remote access session.
    RemoteAccessSession -> Maybe Text
message :: Prelude.Maybe Prelude.Text,
    -- | The name of the remote access session.
    RemoteAccessSession -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | This flag is set to @true@ if remote debugging is enabled for the remote
    -- access session.
    --
    -- Remote debugging is
    -- <https://docs.aws.amazon.com/devicefarm/latest/developerguide/history.html no longer supported>.
    RemoteAccessSession -> Maybe Bool
remoteDebugEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The ARN for the app to be recorded in the remote access session.
    RemoteAccessSession -> Maybe Text
remoteRecordAppArn :: Prelude.Maybe Prelude.Text,
    -- | This flag is set to @true@ if remote recording is enabled for the remote
    -- access session.
    RemoteAccessSession -> Maybe Bool
remoteRecordEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The result of the remote access session. Can be any of the following:
    --
    -- -   PENDING.
    --
    -- -   PASSED.
    --
    -- -   WARNED.
    --
    -- -   FAILED.
    --
    -- -   SKIPPED.
    --
    -- -   ERRORED.
    --
    -- -   STOPPED.
    RemoteAccessSession -> Maybe ExecutionResult
result :: Prelude.Maybe ExecutionResult,
    -- | 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/.
    RemoteAccessSession -> Maybe Bool
skipAppResign :: Prelude.Maybe Prelude.Bool,
    -- | The date and time the remote access session was started.
    RemoteAccessSession -> Maybe POSIX
started :: Prelude.Maybe Data.POSIX,
    -- | The status of the remote access session. Can be any of the following:
    --
    -- -   PENDING.
    --
    -- -   PENDING_CONCURRENCY.
    --
    -- -   PENDING_DEVICE.
    --
    -- -   PROCESSING.
    --
    -- -   SCHEDULING.
    --
    -- -   PREPARING.
    --
    -- -   RUNNING.
    --
    -- -   COMPLETED.
    --
    -- -   STOPPING.
    RemoteAccessSession -> Maybe ExecutionStatus
status :: Prelude.Maybe ExecutionStatus,
    -- | The date and time the remote access session was stopped.
    RemoteAccessSession -> Maybe POSIX
stopped :: Prelude.Maybe Data.POSIX,
    -- | The VPC security groups and subnets that are attached to a project.
    RemoteAccessSession -> Maybe VpcConfig
vpcConfig :: Prelude.Maybe VpcConfig
  }
  deriving (RemoteAccessSession -> RemoteAccessSession -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoteAccessSession -> RemoteAccessSession -> Bool
$c/= :: RemoteAccessSession -> RemoteAccessSession -> Bool
== :: RemoteAccessSession -> RemoteAccessSession -> Bool
$c== :: RemoteAccessSession -> RemoteAccessSession -> Bool
Prelude.Eq, ReadPrec [RemoteAccessSession]
ReadPrec RemoteAccessSession
Int -> ReadS RemoteAccessSession
ReadS [RemoteAccessSession]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RemoteAccessSession]
$creadListPrec :: ReadPrec [RemoteAccessSession]
readPrec :: ReadPrec RemoteAccessSession
$creadPrec :: ReadPrec RemoteAccessSession
readList :: ReadS [RemoteAccessSession]
$creadList :: ReadS [RemoteAccessSession]
readsPrec :: Int -> ReadS RemoteAccessSession
$creadsPrec :: Int -> ReadS RemoteAccessSession
Prelude.Read, Int -> RemoteAccessSession -> ShowS
[RemoteAccessSession] -> ShowS
RemoteAccessSession -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RemoteAccessSession] -> ShowS
$cshowList :: [RemoteAccessSession] -> ShowS
show :: RemoteAccessSession -> String
$cshow :: RemoteAccessSession -> String
showsPrec :: Int -> RemoteAccessSession -> ShowS
$cshowsPrec :: Int -> RemoteAccessSession -> ShowS
Prelude.Show, forall x. Rep RemoteAccessSession x -> RemoteAccessSession
forall x. RemoteAccessSession -> Rep RemoteAccessSession x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RemoteAccessSession x -> RemoteAccessSession
$cfrom :: forall x. RemoteAccessSession -> Rep RemoteAccessSession x
Prelude.Generic)

-- |
-- Create a value of 'RemoteAccessSession' 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', 'remoteAccessSession_arn' - The Amazon Resource Name (ARN) of the remote access session.
--
-- 'billingMethod', 'remoteAccessSession_billingMethod' - The billing method of the remote access session. Possible values include
-- @METERED@ or @UNMETERED@. For more information about metered devices,
-- see
-- <https://docs.aws.amazon.com/devicefarm/latest/developerguide/welcome.html#welcome-terminology AWS Device Farm terminology>.
--
-- 'clientId', 'remoteAccessSession_clientId' - Unique identifier of your client for the remote access session. Only
-- returned if remote debugging is enabled for the remote access session.
--
-- Remote debugging is
-- <https://docs.aws.amazon.com/devicefarm/latest/developerguide/history.html no longer supported>.
--
-- 'created', 'remoteAccessSession_created' - The date and time the remote access session was created.
--
-- 'device', 'remoteAccessSession_device' - The device (phone or tablet) used in the remote access session.
--
-- 'deviceMinutes', 'remoteAccessSession_deviceMinutes' - The number of minutes a device is used in a remote access session
-- (including setup and teardown minutes).
--
-- 'deviceUdid', 'remoteAccessSession_deviceUdid' - Unique device identifier for the remote device. Only returned if remote
-- debugging is enabled for the remote access session.
--
-- Remote debugging is
-- <https://docs.aws.amazon.com/devicefarm/latest/developerguide/history.html no longer supported>.
--
-- 'endpoint', 'remoteAccessSession_endpoint' - The endpoint for the remote access sesssion.
--
-- 'hostAddress', 'remoteAccessSession_hostAddress' - IP address of the EC2 host where you need to connect to remotely debug
-- devices. Only returned if remote debugging is enabled for the remote
-- access session.
--
-- Remote debugging is
-- <https://docs.aws.amazon.com/devicefarm/latest/developerguide/history.html no longer supported>.
--
-- 'instanceArn', 'remoteAccessSession_instanceArn' - The ARN of the instance.
--
-- 'interactionMode', 'remoteAccessSession_interactionMode' - The interaction mode of the remote access session. Valid values are:
--
-- -   INTERACTIVE: You can interact with the iOS device by viewing,
--     touching, and rotating the screen. You cannot run XCUITest
--     framework-based tests in this mode.
--
-- -   NO_VIDEO: You are connected to the device, but cannot interact with
--     it or view the screen. This mode has the fastest test execution
--     speed. You can run XCUITest framework-based tests in this mode.
--
-- -   VIDEO_ONLY: You can view the screen, but cannot touch or rotate it.
--     You can run XCUITest framework-based tests and watch the screen in
--     this mode.
--
-- 'message', 'remoteAccessSession_message' - A message about the remote access session.
--
-- 'name', 'remoteAccessSession_name' - The name of the remote access session.
--
-- 'remoteDebugEnabled', 'remoteAccessSession_remoteDebugEnabled' - This flag is set to @true@ if remote debugging is enabled for the remote
-- access session.
--
-- Remote debugging is
-- <https://docs.aws.amazon.com/devicefarm/latest/developerguide/history.html no longer supported>.
--
-- 'remoteRecordAppArn', 'remoteAccessSession_remoteRecordAppArn' - The ARN for the app to be recorded in the remote access session.
--
-- 'remoteRecordEnabled', 'remoteAccessSession_remoteRecordEnabled' - This flag is set to @true@ if remote recording is enabled for the remote
-- access session.
--
-- 'result', 'remoteAccessSession_result' - The result of the remote access session. Can be any of the following:
--
-- -   PENDING.
--
-- -   PASSED.
--
-- -   WARNED.
--
-- -   FAILED.
--
-- -   SKIPPED.
--
-- -   ERRORED.
--
-- -   STOPPED.
--
-- 'skipAppResign', 'remoteAccessSession_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', 'remoteAccessSession_started' - The date and time the remote access session was started.
--
-- 'status', 'remoteAccessSession_status' - The status of the remote access session. Can be any of the following:
--
-- -   PENDING.
--
-- -   PENDING_CONCURRENCY.
--
-- -   PENDING_DEVICE.
--
-- -   PROCESSING.
--
-- -   SCHEDULING.
--
-- -   PREPARING.
--
-- -   RUNNING.
--
-- -   COMPLETED.
--
-- -   STOPPING.
--
-- 'stopped', 'remoteAccessSession_stopped' - The date and time the remote access session was stopped.
--
-- 'vpcConfig', 'remoteAccessSession_vpcConfig' - The VPC security groups and subnets that are attached to a project.
newRemoteAccessSession ::
  RemoteAccessSession
newRemoteAccessSession :: RemoteAccessSession
newRemoteAccessSession =
  RemoteAccessSession'
    { $sel:arn:RemoteAccessSession' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:billingMethod:RemoteAccessSession' :: Maybe BillingMethod
billingMethod = forall a. Maybe a
Prelude.Nothing,
      $sel:clientId:RemoteAccessSession' :: Maybe Text
clientId = forall a. Maybe a
Prelude.Nothing,
      $sel:created:RemoteAccessSession' :: Maybe POSIX
created = forall a. Maybe a
Prelude.Nothing,
      $sel:device:RemoteAccessSession' :: Maybe Device
device = forall a. Maybe a
Prelude.Nothing,
      $sel:deviceMinutes:RemoteAccessSession' :: Maybe DeviceMinutes
deviceMinutes = forall a. Maybe a
Prelude.Nothing,
      $sel:deviceUdid:RemoteAccessSession' :: Maybe Text
deviceUdid = forall a. Maybe a
Prelude.Nothing,
      $sel:endpoint:RemoteAccessSession' :: Maybe Text
endpoint = forall a. Maybe a
Prelude.Nothing,
      $sel:hostAddress:RemoteAccessSession' :: Maybe Text
hostAddress = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceArn:RemoteAccessSession' :: Maybe Text
instanceArn = forall a. Maybe a
Prelude.Nothing,
      $sel:interactionMode:RemoteAccessSession' :: Maybe InteractionMode
interactionMode = forall a. Maybe a
Prelude.Nothing,
      $sel:message:RemoteAccessSession' :: Maybe Text
message = forall a. Maybe a
Prelude.Nothing,
      $sel:name:RemoteAccessSession' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:remoteDebugEnabled:RemoteAccessSession' :: Maybe Bool
remoteDebugEnabled = forall a. Maybe a
Prelude.Nothing,
      $sel:remoteRecordAppArn:RemoteAccessSession' :: Maybe Text
remoteRecordAppArn = forall a. Maybe a
Prelude.Nothing,
      $sel:remoteRecordEnabled:RemoteAccessSession' :: Maybe Bool
remoteRecordEnabled = forall a. Maybe a
Prelude.Nothing,
      $sel:result:RemoteAccessSession' :: Maybe ExecutionResult
result = forall a. Maybe a
Prelude.Nothing,
      $sel:skipAppResign:RemoteAccessSession' :: Maybe Bool
skipAppResign = forall a. Maybe a
Prelude.Nothing,
      $sel:started:RemoteAccessSession' :: Maybe POSIX
started = forall a. Maybe a
Prelude.Nothing,
      $sel:status:RemoteAccessSession' :: Maybe ExecutionStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:stopped:RemoteAccessSession' :: Maybe POSIX
stopped = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcConfig:RemoteAccessSession' :: Maybe VpcConfig
vpcConfig = forall a. Maybe a
Prelude.Nothing
    }

-- | The Amazon Resource Name (ARN) of the remote access session.
remoteAccessSession_arn :: Lens.Lens' RemoteAccessSession (Prelude.Maybe Prelude.Text)
remoteAccessSession_arn :: Lens' RemoteAccessSession (Maybe Text)
remoteAccessSession_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoteAccessSession' {Maybe Text
arn :: Maybe Text
$sel:arn:RemoteAccessSession' :: RemoteAccessSession -> Maybe Text
arn} -> Maybe Text
arn) (\s :: RemoteAccessSession
s@RemoteAccessSession' {} Maybe Text
a -> RemoteAccessSession
s {$sel:arn:RemoteAccessSession' :: Maybe Text
arn = Maybe Text
a} :: RemoteAccessSession)

-- | The billing method of the remote access session. Possible values include
-- @METERED@ or @UNMETERED@. For more information about metered devices,
-- see
-- <https://docs.aws.amazon.com/devicefarm/latest/developerguide/welcome.html#welcome-terminology AWS Device Farm terminology>.
remoteAccessSession_billingMethod :: Lens.Lens' RemoteAccessSession (Prelude.Maybe BillingMethod)
remoteAccessSession_billingMethod :: Lens' RemoteAccessSession (Maybe BillingMethod)
remoteAccessSession_billingMethod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoteAccessSession' {Maybe BillingMethod
billingMethod :: Maybe BillingMethod
$sel:billingMethod:RemoteAccessSession' :: RemoteAccessSession -> Maybe BillingMethod
billingMethod} -> Maybe BillingMethod
billingMethod) (\s :: RemoteAccessSession
s@RemoteAccessSession' {} Maybe BillingMethod
a -> RemoteAccessSession
s {$sel:billingMethod:RemoteAccessSession' :: Maybe BillingMethod
billingMethod = Maybe BillingMethod
a} :: RemoteAccessSession)

-- | Unique identifier of your client for the remote access session. Only
-- returned if remote debugging is enabled for the remote access session.
--
-- Remote debugging is
-- <https://docs.aws.amazon.com/devicefarm/latest/developerguide/history.html no longer supported>.
remoteAccessSession_clientId :: Lens.Lens' RemoteAccessSession (Prelude.Maybe Prelude.Text)
remoteAccessSession_clientId :: Lens' RemoteAccessSession (Maybe Text)
remoteAccessSession_clientId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoteAccessSession' {Maybe Text
clientId :: Maybe Text
$sel:clientId:RemoteAccessSession' :: RemoteAccessSession -> Maybe Text
clientId} -> Maybe Text
clientId) (\s :: RemoteAccessSession
s@RemoteAccessSession' {} Maybe Text
a -> RemoteAccessSession
s {$sel:clientId:RemoteAccessSession' :: Maybe Text
clientId = Maybe Text
a} :: RemoteAccessSession)

-- | The date and time the remote access session was created.
remoteAccessSession_created :: Lens.Lens' RemoteAccessSession (Prelude.Maybe Prelude.UTCTime)
remoteAccessSession_created :: Lens' RemoteAccessSession (Maybe UTCTime)
remoteAccessSession_created = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoteAccessSession' {Maybe POSIX
created :: Maybe POSIX
$sel:created:RemoteAccessSession' :: RemoteAccessSession -> Maybe POSIX
created} -> Maybe POSIX
created) (\s :: RemoteAccessSession
s@RemoteAccessSession' {} Maybe POSIX
a -> RemoteAccessSession
s {$sel:created:RemoteAccessSession' :: Maybe POSIX
created = Maybe POSIX
a} :: RemoteAccessSession) 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) used in the remote access session.
remoteAccessSession_device :: Lens.Lens' RemoteAccessSession (Prelude.Maybe Device)
remoteAccessSession_device :: Lens' RemoteAccessSession (Maybe Device)
remoteAccessSession_device = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoteAccessSession' {Maybe Device
device :: Maybe Device
$sel:device:RemoteAccessSession' :: RemoteAccessSession -> Maybe Device
device} -> Maybe Device
device) (\s :: RemoteAccessSession
s@RemoteAccessSession' {} Maybe Device
a -> RemoteAccessSession
s {$sel:device:RemoteAccessSession' :: Maybe Device
device = Maybe Device
a} :: RemoteAccessSession)

-- | The number of minutes a device is used in a remote access session
-- (including setup and teardown minutes).
remoteAccessSession_deviceMinutes :: Lens.Lens' RemoteAccessSession (Prelude.Maybe DeviceMinutes)
remoteAccessSession_deviceMinutes :: Lens' RemoteAccessSession (Maybe DeviceMinutes)
remoteAccessSession_deviceMinutes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoteAccessSession' {Maybe DeviceMinutes
deviceMinutes :: Maybe DeviceMinutes
$sel:deviceMinutes:RemoteAccessSession' :: RemoteAccessSession -> Maybe DeviceMinutes
deviceMinutes} -> Maybe DeviceMinutes
deviceMinutes) (\s :: RemoteAccessSession
s@RemoteAccessSession' {} Maybe DeviceMinutes
a -> RemoteAccessSession
s {$sel:deviceMinutes:RemoteAccessSession' :: Maybe DeviceMinutes
deviceMinutes = Maybe DeviceMinutes
a} :: RemoteAccessSession)

-- | Unique device identifier for the remote device. Only returned if remote
-- debugging is enabled for the remote access session.
--
-- Remote debugging is
-- <https://docs.aws.amazon.com/devicefarm/latest/developerguide/history.html no longer supported>.
remoteAccessSession_deviceUdid :: Lens.Lens' RemoteAccessSession (Prelude.Maybe Prelude.Text)
remoteAccessSession_deviceUdid :: Lens' RemoteAccessSession (Maybe Text)
remoteAccessSession_deviceUdid = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoteAccessSession' {Maybe Text
deviceUdid :: Maybe Text
$sel:deviceUdid:RemoteAccessSession' :: RemoteAccessSession -> Maybe Text
deviceUdid} -> Maybe Text
deviceUdid) (\s :: RemoteAccessSession
s@RemoteAccessSession' {} Maybe Text
a -> RemoteAccessSession
s {$sel:deviceUdid:RemoteAccessSession' :: Maybe Text
deviceUdid = Maybe Text
a} :: RemoteAccessSession)

-- | The endpoint for the remote access sesssion.
remoteAccessSession_endpoint :: Lens.Lens' RemoteAccessSession (Prelude.Maybe Prelude.Text)
remoteAccessSession_endpoint :: Lens' RemoteAccessSession (Maybe Text)
remoteAccessSession_endpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoteAccessSession' {Maybe Text
endpoint :: Maybe Text
$sel:endpoint:RemoteAccessSession' :: RemoteAccessSession -> Maybe Text
endpoint} -> Maybe Text
endpoint) (\s :: RemoteAccessSession
s@RemoteAccessSession' {} Maybe Text
a -> RemoteAccessSession
s {$sel:endpoint:RemoteAccessSession' :: Maybe Text
endpoint = Maybe Text
a} :: RemoteAccessSession)

-- | IP address of the EC2 host where you need to connect to remotely debug
-- devices. Only returned if remote debugging is enabled for the remote
-- access session.
--
-- Remote debugging is
-- <https://docs.aws.amazon.com/devicefarm/latest/developerguide/history.html no longer supported>.
remoteAccessSession_hostAddress :: Lens.Lens' RemoteAccessSession (Prelude.Maybe Prelude.Text)
remoteAccessSession_hostAddress :: Lens' RemoteAccessSession (Maybe Text)
remoteAccessSession_hostAddress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoteAccessSession' {Maybe Text
hostAddress :: Maybe Text
$sel:hostAddress:RemoteAccessSession' :: RemoteAccessSession -> Maybe Text
hostAddress} -> Maybe Text
hostAddress) (\s :: RemoteAccessSession
s@RemoteAccessSession' {} Maybe Text
a -> RemoteAccessSession
s {$sel:hostAddress:RemoteAccessSession' :: Maybe Text
hostAddress = Maybe Text
a} :: RemoteAccessSession)

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

-- | The interaction mode of the remote access session. Valid values are:
--
-- -   INTERACTIVE: You can interact with the iOS device by viewing,
--     touching, and rotating the screen. You cannot run XCUITest
--     framework-based tests in this mode.
--
-- -   NO_VIDEO: You are connected to the device, but cannot interact with
--     it or view the screen. This mode has the fastest test execution
--     speed. You can run XCUITest framework-based tests in this mode.
--
-- -   VIDEO_ONLY: You can view the screen, but cannot touch or rotate it.
--     You can run XCUITest framework-based tests and watch the screen in
--     this mode.
remoteAccessSession_interactionMode :: Lens.Lens' RemoteAccessSession (Prelude.Maybe InteractionMode)
remoteAccessSession_interactionMode :: Lens' RemoteAccessSession (Maybe InteractionMode)
remoteAccessSession_interactionMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoteAccessSession' {Maybe InteractionMode
interactionMode :: Maybe InteractionMode
$sel:interactionMode:RemoteAccessSession' :: RemoteAccessSession -> Maybe InteractionMode
interactionMode} -> Maybe InteractionMode
interactionMode) (\s :: RemoteAccessSession
s@RemoteAccessSession' {} Maybe InteractionMode
a -> RemoteAccessSession
s {$sel:interactionMode:RemoteAccessSession' :: Maybe InteractionMode
interactionMode = Maybe InteractionMode
a} :: RemoteAccessSession)

-- | A message about the remote access session.
remoteAccessSession_message :: Lens.Lens' RemoteAccessSession (Prelude.Maybe Prelude.Text)
remoteAccessSession_message :: Lens' RemoteAccessSession (Maybe Text)
remoteAccessSession_message = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoteAccessSession' {Maybe Text
message :: Maybe Text
$sel:message:RemoteAccessSession' :: RemoteAccessSession -> Maybe Text
message} -> Maybe Text
message) (\s :: RemoteAccessSession
s@RemoteAccessSession' {} Maybe Text
a -> RemoteAccessSession
s {$sel:message:RemoteAccessSession' :: Maybe Text
message = Maybe Text
a} :: RemoteAccessSession)

-- | The name of the remote access session.
remoteAccessSession_name :: Lens.Lens' RemoteAccessSession (Prelude.Maybe Prelude.Text)
remoteAccessSession_name :: Lens' RemoteAccessSession (Maybe Text)
remoteAccessSession_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoteAccessSession' {Maybe Text
name :: Maybe Text
$sel:name:RemoteAccessSession' :: RemoteAccessSession -> Maybe Text
name} -> Maybe Text
name) (\s :: RemoteAccessSession
s@RemoteAccessSession' {} Maybe Text
a -> RemoteAccessSession
s {$sel:name:RemoteAccessSession' :: Maybe Text
name = Maybe Text
a} :: RemoteAccessSession)

-- | This flag is set to @true@ if remote debugging is enabled for the remote
-- access session.
--
-- Remote debugging is
-- <https://docs.aws.amazon.com/devicefarm/latest/developerguide/history.html no longer supported>.
remoteAccessSession_remoteDebugEnabled :: Lens.Lens' RemoteAccessSession (Prelude.Maybe Prelude.Bool)
remoteAccessSession_remoteDebugEnabled :: Lens' RemoteAccessSession (Maybe Bool)
remoteAccessSession_remoteDebugEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoteAccessSession' {Maybe Bool
remoteDebugEnabled :: Maybe Bool
$sel:remoteDebugEnabled:RemoteAccessSession' :: RemoteAccessSession -> Maybe Bool
remoteDebugEnabled} -> Maybe Bool
remoteDebugEnabled) (\s :: RemoteAccessSession
s@RemoteAccessSession' {} Maybe Bool
a -> RemoteAccessSession
s {$sel:remoteDebugEnabled:RemoteAccessSession' :: Maybe Bool
remoteDebugEnabled = Maybe Bool
a} :: RemoteAccessSession)

-- | The ARN for the app to be recorded in the remote access session.
remoteAccessSession_remoteRecordAppArn :: Lens.Lens' RemoteAccessSession (Prelude.Maybe Prelude.Text)
remoteAccessSession_remoteRecordAppArn :: Lens' RemoteAccessSession (Maybe Text)
remoteAccessSession_remoteRecordAppArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoteAccessSession' {Maybe Text
remoteRecordAppArn :: Maybe Text
$sel:remoteRecordAppArn:RemoteAccessSession' :: RemoteAccessSession -> Maybe Text
remoteRecordAppArn} -> Maybe Text
remoteRecordAppArn) (\s :: RemoteAccessSession
s@RemoteAccessSession' {} Maybe Text
a -> RemoteAccessSession
s {$sel:remoteRecordAppArn:RemoteAccessSession' :: Maybe Text
remoteRecordAppArn = Maybe Text
a} :: RemoteAccessSession)

-- | This flag is set to @true@ if remote recording is enabled for the remote
-- access session.
remoteAccessSession_remoteRecordEnabled :: Lens.Lens' RemoteAccessSession (Prelude.Maybe Prelude.Bool)
remoteAccessSession_remoteRecordEnabled :: Lens' RemoteAccessSession (Maybe Bool)
remoteAccessSession_remoteRecordEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoteAccessSession' {Maybe Bool
remoteRecordEnabled :: Maybe Bool
$sel:remoteRecordEnabled:RemoteAccessSession' :: RemoteAccessSession -> Maybe Bool
remoteRecordEnabled} -> Maybe Bool
remoteRecordEnabled) (\s :: RemoteAccessSession
s@RemoteAccessSession' {} Maybe Bool
a -> RemoteAccessSession
s {$sel:remoteRecordEnabled:RemoteAccessSession' :: Maybe Bool
remoteRecordEnabled = Maybe Bool
a} :: RemoteAccessSession)

-- | The result of the remote access session. Can be any of the following:
--
-- -   PENDING.
--
-- -   PASSED.
--
-- -   WARNED.
--
-- -   FAILED.
--
-- -   SKIPPED.
--
-- -   ERRORED.
--
-- -   STOPPED.
remoteAccessSession_result :: Lens.Lens' RemoteAccessSession (Prelude.Maybe ExecutionResult)
remoteAccessSession_result :: Lens' RemoteAccessSession (Maybe ExecutionResult)
remoteAccessSession_result = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoteAccessSession' {Maybe ExecutionResult
result :: Maybe ExecutionResult
$sel:result:RemoteAccessSession' :: RemoteAccessSession -> Maybe ExecutionResult
result} -> Maybe ExecutionResult
result) (\s :: RemoteAccessSession
s@RemoteAccessSession' {} Maybe ExecutionResult
a -> RemoteAccessSession
s {$sel:result:RemoteAccessSession' :: Maybe ExecutionResult
result = Maybe ExecutionResult
a} :: RemoteAccessSession)

-- | 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/.
remoteAccessSession_skipAppResign :: Lens.Lens' RemoteAccessSession (Prelude.Maybe Prelude.Bool)
remoteAccessSession_skipAppResign :: Lens' RemoteAccessSession (Maybe Bool)
remoteAccessSession_skipAppResign = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoteAccessSession' {Maybe Bool
skipAppResign :: Maybe Bool
$sel:skipAppResign:RemoteAccessSession' :: RemoteAccessSession -> Maybe Bool
skipAppResign} -> Maybe Bool
skipAppResign) (\s :: RemoteAccessSession
s@RemoteAccessSession' {} Maybe Bool
a -> RemoteAccessSession
s {$sel:skipAppResign:RemoteAccessSession' :: Maybe Bool
skipAppResign = Maybe Bool
a} :: RemoteAccessSession)

-- | The date and time the remote access session was started.
remoteAccessSession_started :: Lens.Lens' RemoteAccessSession (Prelude.Maybe Prelude.UTCTime)
remoteAccessSession_started :: Lens' RemoteAccessSession (Maybe UTCTime)
remoteAccessSession_started = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoteAccessSession' {Maybe POSIX
started :: Maybe POSIX
$sel:started:RemoteAccessSession' :: RemoteAccessSession -> Maybe POSIX
started} -> Maybe POSIX
started) (\s :: RemoteAccessSession
s@RemoteAccessSession' {} Maybe POSIX
a -> RemoteAccessSession
s {$sel:started:RemoteAccessSession' :: Maybe POSIX
started = Maybe POSIX
a} :: RemoteAccessSession) 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 status of the remote access session. Can be any of the following:
--
-- -   PENDING.
--
-- -   PENDING_CONCURRENCY.
--
-- -   PENDING_DEVICE.
--
-- -   PROCESSING.
--
-- -   SCHEDULING.
--
-- -   PREPARING.
--
-- -   RUNNING.
--
-- -   COMPLETED.
--
-- -   STOPPING.
remoteAccessSession_status :: Lens.Lens' RemoteAccessSession (Prelude.Maybe ExecutionStatus)
remoteAccessSession_status :: Lens' RemoteAccessSession (Maybe ExecutionStatus)
remoteAccessSession_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoteAccessSession' {Maybe ExecutionStatus
status :: Maybe ExecutionStatus
$sel:status:RemoteAccessSession' :: RemoteAccessSession -> Maybe ExecutionStatus
status} -> Maybe ExecutionStatus
status) (\s :: RemoteAccessSession
s@RemoteAccessSession' {} Maybe ExecutionStatus
a -> RemoteAccessSession
s {$sel:status:RemoteAccessSession' :: Maybe ExecutionStatus
status = Maybe ExecutionStatus
a} :: RemoteAccessSession)

-- | The date and time the remote access session was stopped.
remoteAccessSession_stopped :: Lens.Lens' RemoteAccessSession (Prelude.Maybe Prelude.UTCTime)
remoteAccessSession_stopped :: Lens' RemoteAccessSession (Maybe UTCTime)
remoteAccessSession_stopped = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoteAccessSession' {Maybe POSIX
stopped :: Maybe POSIX
$sel:stopped:RemoteAccessSession' :: RemoteAccessSession -> Maybe POSIX
stopped} -> Maybe POSIX
stopped) (\s :: RemoteAccessSession
s@RemoteAccessSession' {} Maybe POSIX
a -> RemoteAccessSession
s {$sel:stopped:RemoteAccessSession' :: Maybe POSIX
stopped = Maybe POSIX
a} :: RemoteAccessSession) 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 VPC security groups and subnets that are attached to a project.
remoteAccessSession_vpcConfig :: Lens.Lens' RemoteAccessSession (Prelude.Maybe VpcConfig)
remoteAccessSession_vpcConfig :: Lens' RemoteAccessSession (Maybe VpcConfig)
remoteAccessSession_vpcConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoteAccessSession' {Maybe VpcConfig
vpcConfig :: Maybe VpcConfig
$sel:vpcConfig:RemoteAccessSession' :: RemoteAccessSession -> Maybe VpcConfig
vpcConfig} -> Maybe VpcConfig
vpcConfig) (\s :: RemoteAccessSession
s@RemoteAccessSession' {} Maybe VpcConfig
a -> RemoteAccessSession
s {$sel:vpcConfig:RemoteAccessSession' :: Maybe VpcConfig
vpcConfig = Maybe VpcConfig
a} :: RemoteAccessSession)

instance Data.FromJSON RemoteAccessSession where
  parseJSON :: Value -> Parser RemoteAccessSession
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"RemoteAccessSession"
      ( \Object
x ->
          Maybe Text
-> Maybe BillingMethod
-> Maybe Text
-> Maybe POSIX
-> Maybe Device
-> Maybe DeviceMinutes
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe InteractionMode
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Bool
-> Maybe ExecutionResult
-> Maybe Bool
-> Maybe POSIX
-> Maybe ExecutionStatus
-> Maybe POSIX
-> Maybe VpcConfig
-> RemoteAccessSession
RemoteAccessSession'
            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
"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
"clientId")
            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
"deviceUdid")
            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
"endpoint")
            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
"hostAddress")
            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
"interactionMode")
            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
"remoteDebugEnabled")
            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
"remoteRecordAppArn")
            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
"remoteRecordEnabled")
            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
"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
"vpcConfig")
      )

instance Prelude.Hashable RemoteAccessSession where
  hashWithSalt :: Int -> RemoteAccessSession -> Int
hashWithSalt Int
_salt RemoteAccessSession' {Maybe Bool
Maybe Text
Maybe POSIX
Maybe BillingMethod
Maybe DeviceMinutes
Maybe ExecutionResult
Maybe ExecutionStatus
Maybe InteractionMode
Maybe Device
Maybe VpcConfig
vpcConfig :: Maybe VpcConfig
stopped :: Maybe POSIX
status :: Maybe ExecutionStatus
started :: Maybe POSIX
skipAppResign :: Maybe Bool
result :: Maybe ExecutionResult
remoteRecordEnabled :: Maybe Bool
remoteRecordAppArn :: Maybe Text
remoteDebugEnabled :: Maybe Bool
name :: Maybe Text
message :: Maybe Text
interactionMode :: Maybe InteractionMode
instanceArn :: Maybe Text
hostAddress :: Maybe Text
endpoint :: Maybe Text
deviceUdid :: Maybe Text
deviceMinutes :: Maybe DeviceMinutes
device :: Maybe Device
created :: Maybe POSIX
clientId :: Maybe Text
billingMethod :: Maybe BillingMethod
arn :: Maybe Text
$sel:vpcConfig:RemoteAccessSession' :: RemoteAccessSession -> Maybe VpcConfig
$sel:stopped:RemoteAccessSession' :: RemoteAccessSession -> Maybe POSIX
$sel:status:RemoteAccessSession' :: RemoteAccessSession -> Maybe ExecutionStatus
$sel:started:RemoteAccessSession' :: RemoteAccessSession -> Maybe POSIX
$sel:skipAppResign:RemoteAccessSession' :: RemoteAccessSession -> Maybe Bool
$sel:result:RemoteAccessSession' :: RemoteAccessSession -> Maybe ExecutionResult
$sel:remoteRecordEnabled:RemoteAccessSession' :: RemoteAccessSession -> Maybe Bool
$sel:remoteRecordAppArn:RemoteAccessSession' :: RemoteAccessSession -> Maybe Text
$sel:remoteDebugEnabled:RemoteAccessSession' :: RemoteAccessSession -> Maybe Bool
$sel:name:RemoteAccessSession' :: RemoteAccessSession -> Maybe Text
$sel:message:RemoteAccessSession' :: RemoteAccessSession -> Maybe Text
$sel:interactionMode:RemoteAccessSession' :: RemoteAccessSession -> Maybe InteractionMode
$sel:instanceArn:RemoteAccessSession' :: RemoteAccessSession -> Maybe Text
$sel:hostAddress:RemoteAccessSession' :: RemoteAccessSession -> Maybe Text
$sel:endpoint:RemoteAccessSession' :: RemoteAccessSession -> Maybe Text
$sel:deviceUdid:RemoteAccessSession' :: RemoteAccessSession -> Maybe Text
$sel:deviceMinutes:RemoteAccessSession' :: RemoteAccessSession -> Maybe DeviceMinutes
$sel:device:RemoteAccessSession' :: RemoteAccessSession -> Maybe Device
$sel:created:RemoteAccessSession' :: RemoteAccessSession -> Maybe POSIX
$sel:clientId:RemoteAccessSession' :: RemoteAccessSession -> Maybe Text
$sel:billingMethod:RemoteAccessSession' :: RemoteAccessSession -> Maybe BillingMethod
$sel:arn:RemoteAccessSession' :: RemoteAccessSession -> 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 BillingMethod
billingMethod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientId
      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
deviceUdid
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
endpoint
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
hostAddress
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
instanceArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InteractionMode
interactionMode
      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 Bool
remoteDebugEnabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
remoteRecordAppArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
remoteRecordEnabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ExecutionResult
result
      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 VpcConfig
vpcConfig

instance Prelude.NFData RemoteAccessSession where
  rnf :: RemoteAccessSession -> ()
rnf RemoteAccessSession' {Maybe Bool
Maybe Text
Maybe POSIX
Maybe BillingMethod
Maybe DeviceMinutes
Maybe ExecutionResult
Maybe ExecutionStatus
Maybe InteractionMode
Maybe Device
Maybe VpcConfig
vpcConfig :: Maybe VpcConfig
stopped :: Maybe POSIX
status :: Maybe ExecutionStatus
started :: Maybe POSIX
skipAppResign :: Maybe Bool
result :: Maybe ExecutionResult
remoteRecordEnabled :: Maybe Bool
remoteRecordAppArn :: Maybe Text
remoteDebugEnabled :: Maybe Bool
name :: Maybe Text
message :: Maybe Text
interactionMode :: Maybe InteractionMode
instanceArn :: Maybe Text
hostAddress :: Maybe Text
endpoint :: Maybe Text
deviceUdid :: Maybe Text
deviceMinutes :: Maybe DeviceMinutes
device :: Maybe Device
created :: Maybe POSIX
clientId :: Maybe Text
billingMethod :: Maybe BillingMethod
arn :: Maybe Text
$sel:vpcConfig:RemoteAccessSession' :: RemoteAccessSession -> Maybe VpcConfig
$sel:stopped:RemoteAccessSession' :: RemoteAccessSession -> Maybe POSIX
$sel:status:RemoteAccessSession' :: RemoteAccessSession -> Maybe ExecutionStatus
$sel:started:RemoteAccessSession' :: RemoteAccessSession -> Maybe POSIX
$sel:skipAppResign:RemoteAccessSession' :: RemoteAccessSession -> Maybe Bool
$sel:result:RemoteAccessSession' :: RemoteAccessSession -> Maybe ExecutionResult
$sel:remoteRecordEnabled:RemoteAccessSession' :: RemoteAccessSession -> Maybe Bool
$sel:remoteRecordAppArn:RemoteAccessSession' :: RemoteAccessSession -> Maybe Text
$sel:remoteDebugEnabled:RemoteAccessSession' :: RemoteAccessSession -> Maybe Bool
$sel:name:RemoteAccessSession' :: RemoteAccessSession -> Maybe Text
$sel:message:RemoteAccessSession' :: RemoteAccessSession -> Maybe Text
$sel:interactionMode:RemoteAccessSession' :: RemoteAccessSession -> Maybe InteractionMode
$sel:instanceArn:RemoteAccessSession' :: RemoteAccessSession -> Maybe Text
$sel:hostAddress:RemoteAccessSession' :: RemoteAccessSession -> Maybe Text
$sel:endpoint:RemoteAccessSession' :: RemoteAccessSession -> Maybe Text
$sel:deviceUdid:RemoteAccessSession' :: RemoteAccessSession -> Maybe Text
$sel:deviceMinutes:RemoteAccessSession' :: RemoteAccessSession -> Maybe DeviceMinutes
$sel:device:RemoteAccessSession' :: RemoteAccessSession -> Maybe Device
$sel:created:RemoteAccessSession' :: RemoteAccessSession -> Maybe POSIX
$sel:clientId:RemoteAccessSession' :: RemoteAccessSession -> Maybe Text
$sel:billingMethod:RemoteAccessSession' :: RemoteAccessSession -> Maybe BillingMethod
$sel:arn:RemoteAccessSession' :: RemoteAccessSession -> 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 BillingMethod
billingMethod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientId
      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
deviceUdid
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
endpoint
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
hostAddress
      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 InteractionMode
interactionMode
      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 Bool
remoteDebugEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
remoteRecordAppArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
remoteRecordEnabled
      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 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 VpcConfig
vpcConfig