{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TemplateHaskell #-}

module Test.WebDriver.Capabilities.ChromeOptions where

import Control.Monad.IO.Class
import Data.Aeson
import Data.Aeson as A
import Data.Aeson.TH
import Data.ByteString.Base64.Lazy as B64
import Data.ByteString.Lazy as LBS
import qualified Data.Text.Lazy as TL
import Data.Text.Lazy.Encoding (decodeLatin1)
import Lens.Micro.TH
import Test.WebDriver.Capabilities.Aeson


-- | See https://developer.chrome.com/docs/chromedriver/mobile-emulation
data ChromeDeviceMetrics = ChromeDeviceMetrics {
  -- | The width in pixels of the device's screen.
  ChromeDeviceMetrics -> Maybe Int
_chromeDeviceMetricsWidth :: Maybe Int
  -- | The height in pixels of the device's screen.
  , ChromeDeviceMetrics -> Maybe Int
_chromeDeviceMetricsHeight :: Maybe Int
  -- | The device's pixel ratio.
  , ChromeDeviceMetrics -> Maybe Double
_chromeDeviceMetricsPixelRatio :: Maybe Double
  -- | Whether to emulate touch events. The value defaults to true and usually
  -- can be omitted.
  , ChromeDeviceMetrics -> Maybe Bool
_chromeDeviceMetricsTouch :: Maybe Bool
  -- | Whether the browser must behave as a mobile user agent (overlay
  -- scrollbars, emit orientation events, shrink the content to fit the
  -- viewport, etc.). The value defaults to true and usually can be omitted.
  , ChromeDeviceMetrics -> Maybe Bool
_chromeDeviceMetricsMobile :: Maybe Bool
  } deriving (Int -> ChromeDeviceMetrics -> ShowS
[ChromeDeviceMetrics] -> ShowS
ChromeDeviceMetrics -> String
(Int -> ChromeDeviceMetrics -> ShowS)
-> (ChromeDeviceMetrics -> String)
-> ([ChromeDeviceMetrics] -> ShowS)
-> Show ChromeDeviceMetrics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChromeDeviceMetrics -> ShowS
showsPrec :: Int -> ChromeDeviceMetrics -> ShowS
$cshow :: ChromeDeviceMetrics -> String
show :: ChromeDeviceMetrics -> String
$cshowList :: [ChromeDeviceMetrics] -> ShowS
showList :: [ChromeDeviceMetrics] -> ShowS
Show, ChromeDeviceMetrics -> ChromeDeviceMetrics -> Bool
(ChromeDeviceMetrics -> ChromeDeviceMetrics -> Bool)
-> (ChromeDeviceMetrics -> ChromeDeviceMetrics -> Bool)
-> Eq ChromeDeviceMetrics
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChromeDeviceMetrics -> ChromeDeviceMetrics -> Bool
== :: ChromeDeviceMetrics -> ChromeDeviceMetrics -> Bool
$c/= :: ChromeDeviceMetrics -> ChromeDeviceMetrics -> Bool
/= :: ChromeDeviceMetrics -> ChromeDeviceMetrics -> Bool
Eq)
deriveJSON toCamel3 ''ChromeDeviceMetrics
makeLenses ''ChromeDeviceMetrics

data BrandAndVersion = BrandAndVersion {
  BrandAndVersion -> String
brandAndVersionBrand :: String
  , BrandAndVersion -> String
brandAndVersionVersion :: String
  } deriving (Int -> BrandAndVersion -> ShowS
[BrandAndVersion] -> ShowS
BrandAndVersion -> String
(Int -> BrandAndVersion -> ShowS)
-> (BrandAndVersion -> String)
-> ([BrandAndVersion] -> ShowS)
-> Show BrandAndVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BrandAndVersion -> ShowS
showsPrec :: Int -> BrandAndVersion -> ShowS
$cshow :: BrandAndVersion -> String
show :: BrandAndVersion -> String
$cshowList :: [BrandAndVersion] -> ShowS
showList :: [BrandAndVersion] -> ShowS
Show, BrandAndVersion -> BrandAndVersion -> Bool
(BrandAndVersion -> BrandAndVersion -> Bool)
-> (BrandAndVersion -> BrandAndVersion -> Bool)
-> Eq BrandAndVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BrandAndVersion -> BrandAndVersion -> Bool
== :: BrandAndVersion -> BrandAndVersion -> Bool
$c/= :: BrandAndVersion -> BrandAndVersion -> Bool
/= :: BrandAndVersion -> BrandAndVersion -> Bool
Eq)
deriveJSON toCamel3 ''BrandAndVersion
makeLenses ''BrandAndVersion

-- | See https://developer.chrome.com/docs/chromedriver/mobile-emulation
data ChromeClientHints = ChromeClientHints {
  -- | The operating system. It can be either a known value ("Android", "Chrome
  -- OS", "Chromium OS", "Fuchsia", "Linux", "macOS", "Windows"), that exactly
  -- matches the value returned by Chrome running on the given platform, or it
  -- can be a user defined value. This value is mandatory.
  ChromeClientHints -> String
_chromeClientHintsPlatform :: String
  -- | Whether the browser should request a mobile or desktop resource version.
  -- Usually Chrome running on a mobile phone with Android sets this value to
  -- true. Chrome on a tablet Android device sets this value to false. Chrome on
  -- a desktop device also sets this value to false. You can use this
  -- information to specify a realistic emulation. This value is mandatory.
  , ChromeClientHints -> Bool
_chromeClientHintsMobile :: Bool
  -- | List of brand / major version pairs. If omitted the browser uses its own
  -- values.
  , ChromeClientHints -> Maybe [BrandAndVersion]
_chromeClientHintsBrands :: Maybe [BrandAndVersion]
  -- | List of brand / version pairs. It omitted the browser uses its own
  -- values.
  , ChromeClientHints -> Maybe [BrandAndVersion]
_chromeClientHintsFullVersionList :: Maybe [BrandAndVersion]
  -- | OS version. Defaults to empty string.
  , ChromeClientHints -> Maybe String
_chromeClientHintsPlatformVersion :: Maybe String
  -- | Device model. Defaults to empty string.
  , ChromeClientHints -> Maybe String
_chromeClientHintsModel :: Maybe String
  -- | CPU architecture. Known values are "x86" and "arm". The user is free to
  -- provide any string value. Defaults to empty string.
  , ChromeClientHints -> Maybe String
_chromeClientHintsArchitecture :: Maybe String
  -- | Platform bitness. Known values are "32" and "64". The user is free to
  -- provide any string value. Defaults to empty string.
  , ChromeClientHints -> Maybe String
_chromeClientHintsBitness :: Maybe String
  -- | Emulation of windows 32 on windows 64. A boolean value that defaults to
  -- false.
  , ChromeClientHints -> Maybe Bool
_chromeClientHintsWow64 :: Maybe Bool
  } deriving (Int -> ChromeClientHints -> ShowS
[ChromeClientHints] -> ShowS
ChromeClientHints -> String
(Int -> ChromeClientHints -> ShowS)
-> (ChromeClientHints -> String)
-> ([ChromeClientHints] -> ShowS)
-> Show ChromeClientHints
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChromeClientHints -> ShowS
showsPrec :: Int -> ChromeClientHints -> ShowS
$cshow :: ChromeClientHints -> String
show :: ChromeClientHints -> String
$cshowList :: [ChromeClientHints] -> ShowS
showList :: [ChromeClientHints] -> ShowS
Show, ChromeClientHints -> ChromeClientHints -> Bool
(ChromeClientHints -> ChromeClientHints -> Bool)
-> (ChromeClientHints -> ChromeClientHints -> Bool)
-> Eq ChromeClientHints
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChromeClientHints -> ChromeClientHints -> Bool
== :: ChromeClientHints -> ChromeClientHints -> Bool
$c/= :: ChromeClientHints -> ChromeClientHints -> Bool
/= :: ChromeClientHints -> ChromeClientHints -> Bool
Eq)
deriveJSON toCamel3 ''ChromeClientHints
makeLenses ''ChromeClientHints
mkChromeClientHints :: String -> Bool -> ChromeClientHints
mkChromeClientHints :: String -> Bool -> ChromeClientHints
mkChromeClientHints String
platform Bool
mobile = ChromeClientHints {
  _chromeClientHintsPlatform :: String
_chromeClientHintsPlatform = String
platform
  , _chromeClientHintsMobile :: Bool
_chromeClientHintsMobile = Bool
mobile
  , _chromeClientHintsBrands :: Maybe [BrandAndVersion]
_chromeClientHintsBrands = Maybe [BrandAndVersion]
forall a. Maybe a
Nothing
  , _chromeClientHintsFullVersionList :: Maybe [BrandAndVersion]
_chromeClientHintsFullVersionList = Maybe [BrandAndVersion]
forall a. Maybe a
Nothing
  , _chromeClientHintsPlatformVersion :: Maybe String
_chromeClientHintsPlatformVersion = Maybe String
forall a. Maybe a
Nothing
  , _chromeClientHintsModel :: Maybe String
_chromeClientHintsModel = Maybe String
forall a. Maybe a
Nothing
  , _chromeClientHintsArchitecture :: Maybe String
_chromeClientHintsArchitecture = Maybe String
forall a. Maybe a
Nothing
  , _chromeClientHintsBitness :: Maybe String
_chromeClientHintsBitness = Maybe String
forall a. Maybe a
Nothing
  , _chromeClientHintsWow64 :: Maybe Bool
_chromeClientHintsWow64 = Maybe Bool
forall a. Maybe a
Nothing
  }

-- | See https://developer.chrome.com/docs/chromedriver/mobile-emulation
data ChromeMobileEmulation =
  -- | Specify a known device. To enable device emulation with a specific
  -- device, the "mobileEmulation" dictionary must contain a "deviceName." Use a
  -- valid device name from the DevTools Emulated Devices settings as the value
  -- for "deviceName."
  ChromeMobileEmulationSpecificDevice {
    ChromeMobileEmulation -> String
_chromeMobileEmulationDeviceName :: String
  }
  -- | Specify individual device attributes.
  | ChromeMobileEmulationIndividualAttributes {
      ChromeMobileEmulation -> Maybe ChromeDeviceMetrics
_chromeMobileEmulationDeviceMetrics :: Maybe ChromeDeviceMetrics
      , ChromeMobileEmulation -> Maybe ChromeClientHints
_chromeMobileEmulationClientHints :: Maybe ChromeClientHints
      -- | ChromeDriver is capable to infer "userAgent" value from "clientHints" on
      -- the following platforms: "Android", "Chrome OS", "Chromium OS", "Fuchsia",
      -- "Linux", "macOS", "Windows". Therefore this value can be omitted.
      --
      -- If "clientHints" dictionary is omitted (legacy mode) ChromeDriver does its
      -- best to infer the "clientHints" from "userAgent". This feature is not
      -- reliable, due to internal ambiguities of "userAgent" value format.
      , ChromeMobileEmulation -> Maybe String
_chromeMobileEmulationUserAgent :: Maybe String
      }
  deriving (Int -> ChromeMobileEmulation -> ShowS
[ChromeMobileEmulation] -> ShowS
ChromeMobileEmulation -> String
(Int -> ChromeMobileEmulation -> ShowS)
-> (ChromeMobileEmulation -> String)
-> ([ChromeMobileEmulation] -> ShowS)
-> Show ChromeMobileEmulation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChromeMobileEmulation -> ShowS
showsPrec :: Int -> ChromeMobileEmulation -> ShowS
$cshow :: ChromeMobileEmulation -> String
show :: ChromeMobileEmulation -> String
$cshowList :: [ChromeMobileEmulation] -> ShowS
showList :: [ChromeMobileEmulation] -> ShowS
Show, ChromeMobileEmulation -> ChromeMobileEmulation -> Bool
(ChromeMobileEmulation -> ChromeMobileEmulation -> Bool)
-> (ChromeMobileEmulation -> ChromeMobileEmulation -> Bool)
-> Eq ChromeMobileEmulation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChromeMobileEmulation -> ChromeMobileEmulation -> Bool
== :: ChromeMobileEmulation -> ChromeMobileEmulation -> Bool
$c/= :: ChromeMobileEmulation -> ChromeMobileEmulation -> Bool
/= :: ChromeMobileEmulation -> ChromeMobileEmulation -> Bool
Eq)
deriveJSON (toCamel3 { sumEncoding = UntaggedValue }) ''ChromeMobileEmulation
makeLenses ''ChromeMobileEmulation

-- | A packed Google Chrome extension (.crx), as base64-encoded 'Text'.
newtype ChromeExtension = ChromeExtension TL.Text
  deriving (ChromeExtension -> ChromeExtension -> Bool
(ChromeExtension -> ChromeExtension -> Bool)
-> (ChromeExtension -> ChromeExtension -> Bool)
-> Eq ChromeExtension
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChromeExtension -> ChromeExtension -> Bool
== :: ChromeExtension -> ChromeExtension -> Bool
$c/= :: ChromeExtension -> ChromeExtension -> Bool
/= :: ChromeExtension -> ChromeExtension -> Bool
Eq, Int -> ChromeExtension -> ShowS
[ChromeExtension] -> ShowS
ChromeExtension -> String
(Int -> ChromeExtension -> ShowS)
-> (ChromeExtension -> String)
-> ([ChromeExtension] -> ShowS)
-> Show ChromeExtension
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChromeExtension -> ShowS
showsPrec :: Int -> ChromeExtension -> ShowS
$cshow :: ChromeExtension -> String
show :: ChromeExtension -> String
$cshowList :: [ChromeExtension] -> ShowS
showList :: [ChromeExtension] -> ShowS
Show, ReadPrec [ChromeExtension]
ReadPrec ChromeExtension
Int -> ReadS ChromeExtension
ReadS [ChromeExtension]
(Int -> ReadS ChromeExtension)
-> ReadS [ChromeExtension]
-> ReadPrec ChromeExtension
-> ReadPrec [ChromeExtension]
-> Read ChromeExtension
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ChromeExtension
readsPrec :: Int -> ReadS ChromeExtension
$creadList :: ReadS [ChromeExtension]
readList :: ReadS [ChromeExtension]
$creadPrec :: ReadPrec ChromeExtension
readPrec :: ReadPrec ChromeExtension
$creadListPrec :: ReadPrec [ChromeExtension]
readListPrec :: ReadPrec [ChromeExtension]
Read, [ChromeExtension] -> Value
[ChromeExtension] -> Encoding
ChromeExtension -> Bool
ChromeExtension -> Value
ChromeExtension -> Encoding
(ChromeExtension -> Value)
-> (ChromeExtension -> Encoding)
-> ([ChromeExtension] -> Value)
-> ([ChromeExtension] -> Encoding)
-> (ChromeExtension -> Bool)
-> ToJSON ChromeExtension
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ChromeExtension -> Value
toJSON :: ChromeExtension -> Value
$ctoEncoding :: ChromeExtension -> Encoding
toEncoding :: ChromeExtension -> Encoding
$ctoJSONList :: [ChromeExtension] -> Value
toJSONList :: [ChromeExtension] -> Value
$ctoEncodingList :: [ChromeExtension] -> Encoding
toEncodingList :: [ChromeExtension] -> Encoding
$comitField :: ChromeExtension -> Bool
omitField :: ChromeExtension -> Bool
ToJSON, Maybe ChromeExtension
Value -> Parser [ChromeExtension]
Value -> Parser ChromeExtension
(Value -> Parser ChromeExtension)
-> (Value -> Parser [ChromeExtension])
-> Maybe ChromeExtension
-> FromJSON ChromeExtension
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ChromeExtension
parseJSON :: Value -> Parser ChromeExtension
$cparseJSONList :: Value -> Parser [ChromeExtension]
parseJSONList :: Value -> Parser [ChromeExtension]
$comittedField :: Maybe ChromeExtension
omittedField :: Maybe ChromeExtension
FromJSON)

-- | Load a .crx file as a 'ChromeExtension'.
loadExtension :: MonadIO m => FilePath -> m ChromeExtension
loadExtension :: forall (m :: * -> *). MonadIO m => String -> m ChromeExtension
loadExtension String
path = IO ChromeExtension -> m ChromeExtension
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ChromeExtension -> m ChromeExtension)
-> IO ChromeExtension -> m ChromeExtension
forall a b. (a -> b) -> a -> b
$ ByteString -> ChromeExtension
loadRawExtension (ByteString -> ChromeExtension)
-> IO ByteString -> IO ChromeExtension
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
LBS.readFile String
path

-- | Load raw .crx data as a 'ChromeExtension'.
loadRawExtension :: ByteString -> ChromeExtension
loadRawExtension :: ByteString -> ChromeExtension
loadRawExtension = Text -> ChromeExtension
ChromeExtension (Text -> ChromeExtension)
-> (ByteString -> Text) -> ByteString -> ChromeExtension
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeLatin1 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B64.encode

-- | See https://developer.chrome.com/docs/chromedriver/capabilities#chromeoptions_object
data ChromeOptions = ChromeOptions {
  -- | List of command-line arguments to use when starting Chrome. Arguments with an associated value should be separated
  -- by a '=' sign (such as, ['start-maximized', 'user-data-dir=/tmp/temp_profile']). See a list of Chrome arguments:
  -- https://peter.sh/experiments/chromium-command-line-switches/
  ChromeOptions -> Maybe [String]
_chromeOptionsArgs :: Maybe [String]
  -- | Path to the Chrome executable to use. On macOS X, this should be the actual binary, not just the app, such as,
  -- /Applications/Google Chrome.app/Contents/MacOS/Google Chrome.
  , ChromeOptions -> Maybe String
_chromeOptionsBinary :: Maybe FilePath
  -- | A list of Chrome extensions to install on startup. Each item in the list should be a base-64 encoded packed Chrome
  -- extension (.crx)
  , ChromeOptions -> Maybe [ChromeExtension]
_chromeOptionsExtensions :: Maybe [ChromeExtension]
  -- | A dictionary with each entry consisting of the name of the preference and its value. These preferences are applied
  -- to the Local State file in the user data folder.
  , ChromeOptions -> Maybe Object
_chromeOptionsLocalState :: Maybe A.Object
  -- | A dictionary with each entry consisting of the name of the preference and its value. These preferences are only
  -- applied to the user profile in use. See the 'Preferences' file in Chrome's user data directory for examples.
  , ChromeOptions -> Maybe Object
_chromeOptionsPrefs :: Maybe A.Object
  -- | If false, Chrome is quit when ChromeDriver is killed, regardless of whether the session is quit.
  -- If true, Chrome only quits if the session is quit or closed. If true and the session isn't quit, ChromeDriver
  -- cannot clean up the temporary user data directory that the running Chrome instance is using.
  , ChromeOptions -> Maybe Bool
_chromeOptionsDetach :: Maybe Bool
  -- | An address of a Chrome debugger server to connect to, in the form of @<hostname/ip:port>@, such as '127.0.0.1:38947'
  , ChromeOptions -> Maybe String
_chromeOptionsDebuggerAddress :: Maybe String
  -- | List of Chrome command line switches to exclude that ChromeDriver by default passes when starting Chrome. Don't
  -- prefix switches with --.
  , ChromeOptions -> Maybe [String]
_chromeOptionsExcludeSwitches :: Maybe [String]
  -- | Directory to store Chrome minidumps. (Supported only on Linux.)
  , ChromeOptions -> Maybe String
_chromeOptionsMinidumpPath :: Maybe FilePath
  -- | A dictionary with either a value for "deviceName," or values for "deviceMetrics", and "userAgent." Refer to Mobile
  -- Emulation for more information.
  , ChromeOptions -> Maybe ChromeMobileEmulation
_chromeOptionsMobileEmulation :: Maybe ChromeMobileEmulation
  -- | An optional dictionary that specifies performance logging preferences.
  , ChromeOptions -> Maybe Object
_chromeOptionsPerfLoggingPrefs :: Maybe A.Object
  -- | A list of window types that appear in the list of window handles. For access to webview elements, include "webview"
  -- in this list.
  , ChromeOptions -> Maybe [String]
_chromeOptionsWindowTypes :: Maybe [String]
  }
  deriving (Int -> ChromeOptions -> ShowS
[ChromeOptions] -> ShowS
ChromeOptions -> String
(Int -> ChromeOptions -> ShowS)
-> (ChromeOptions -> String)
-> ([ChromeOptions] -> ShowS)
-> Show ChromeOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChromeOptions -> ShowS
showsPrec :: Int -> ChromeOptions -> ShowS
$cshow :: ChromeOptions -> String
show :: ChromeOptions -> String
$cshowList :: [ChromeOptions] -> ShowS
showList :: [ChromeOptions] -> ShowS
Show, ChromeOptions -> ChromeOptions -> Bool
(ChromeOptions -> ChromeOptions -> Bool)
-> (ChromeOptions -> ChromeOptions -> Bool) -> Eq ChromeOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChromeOptions -> ChromeOptions -> Bool
== :: ChromeOptions -> ChromeOptions -> Bool
$c/= :: ChromeOptions -> ChromeOptions -> Bool
/= :: ChromeOptions -> ChromeOptions -> Bool
Eq)
deriveJSON toCamel2 ''ChromeOptions
makeLenses ''ChromeOptions

-- | Empty 'ChromeOptions'.
defaultChromeOptions :: ChromeOptions
defaultChromeOptions :: ChromeOptions
defaultChromeOptions = ChromeOptions {
  _chromeOptionsArgs :: Maybe [String]
_chromeOptionsArgs = Maybe [String]
forall a. Maybe a
Nothing
  , _chromeOptionsBinary :: Maybe String
_chromeOptionsBinary = Maybe String
forall a. Maybe a
Nothing
  , _chromeOptionsExtensions :: Maybe [ChromeExtension]
_chromeOptionsExtensions = Maybe [ChromeExtension]
forall a. Maybe a
Nothing
  , _chromeOptionsLocalState :: Maybe Object
_chromeOptionsLocalState = Maybe Object
forall a. Maybe a
Nothing
  , _chromeOptionsPrefs :: Maybe Object
_chromeOptionsPrefs = Maybe Object
forall a. Maybe a
Nothing
  , _chromeOptionsDetach :: Maybe Bool
_chromeOptionsDetach = Maybe Bool
forall a. Maybe a
Nothing
  , _chromeOptionsDebuggerAddress :: Maybe String
_chromeOptionsDebuggerAddress = Maybe String
forall a. Maybe a
Nothing
  , _chromeOptionsExcludeSwitches :: Maybe [String]
_chromeOptionsExcludeSwitches = Maybe [String]
forall a. Maybe a
Nothing
  , _chromeOptionsMinidumpPath :: Maybe String
_chromeOptionsMinidumpPath = Maybe String
forall a. Maybe a
Nothing
  , _chromeOptionsMobileEmulation :: Maybe ChromeMobileEmulation
_chromeOptionsMobileEmulation = Maybe ChromeMobileEmulation
forall a. Maybe a
Nothing
  , _chromeOptionsPerfLoggingPrefs :: Maybe Object
_chromeOptionsPerfLoggingPrefs = Maybe Object
forall a. Maybe a
Nothing
  , _chromeOptionsWindowTypes :: Maybe [String]
_chromeOptionsWindowTypes = Maybe [String]
forall a. Maybe a
Nothing
  }