module Test.WebDriver.Capabilities where
import Test.WebDriver.Firefox.Profile
import Test.WebDriver.Chrome.Extension
import Test.WebDriver.JSON
import Data.Aeson
import Data.Aeson.Types (Parser, typeMismatch, Pair)
import qualified Data.HashMap.Strict as HM (delete, toList)
import Data.Text (Text, toLower, toUpper)
import Data.Default (Default(..))
import Data.Word (Word16)
import Data.Maybe (fromMaybe, catMaybes)
import Data.String (fromString)
import Control.Applicative
import Control.Exception.Lifted (throw)
data Capabilities =
Capabilities {
browser :: Browser
, version :: Maybe String
, platform :: Platform
, proxy :: ProxyType
, javascriptEnabled :: Maybe Bool
, takesScreenshot :: Maybe Bool
, handlesAlerts :: Maybe Bool
, databaseEnabled :: Maybe Bool
, locationContextEnabled :: Maybe Bool
, applicationCacheEnabled :: Maybe Bool
, browserConnectionEnabled :: Maybe Bool
, cssSelectorsEnabled :: Maybe Bool
, webStorageEnabled :: Maybe Bool
, rotatable :: Maybe Bool
, acceptSSLCerts :: Maybe Bool
, nativeEvents :: Maybe Bool
, unexpectedAlertBehavior :: Maybe UnexpectedAlertBehavior
, additionalCaps :: [Pair]
} deriving (Eq, Show)
instance Default Capabilities where
def = Capabilities { browser = firefox
, version = Nothing
, platform = Any
, javascriptEnabled = Nothing
, takesScreenshot = Nothing
, handlesAlerts = Nothing
, databaseEnabled = Nothing
, locationContextEnabled = Nothing
, applicationCacheEnabled = Nothing
, browserConnectionEnabled = Nothing
, cssSelectorsEnabled = Nothing
, webStorageEnabled = Nothing
, rotatable = Nothing
, acceptSSLCerts = Nothing
, nativeEvents = Nothing
, proxy = UseSystemSettings
, unexpectedAlertBehavior = Nothing
, additionalCaps = []
}
defaultCaps :: Capabilities
defaultCaps = def
allCaps :: Capabilities
allCaps = defaultCaps { javascriptEnabled = Just True
, takesScreenshot = Just True
, handlesAlerts = Just True
, databaseEnabled = Just True
, locationContextEnabled = Just True
, applicationCacheEnabled = Just True
, browserConnectionEnabled = Just True
, cssSelectorsEnabled = Just True
, webStorageEnabled = Just True
, rotatable = Just True
, acceptSSLCerts = Just True
, nativeEvents = Just True
}
instance ToJSON Capabilities where
toJSON Capabilities{..} =
object $ [ "browserName" .= browser
, "version" .= version
, "platform" .= platform
, "proxy" .= proxy
, "javascriptEnabled" .= javascriptEnabled
, "takesScreenshot" .= takesScreenshot
, "handlesAlerts" .= handlesAlerts
, "databaseEnabled" .= databaseEnabled
, "locationContextEnabled" .= locationContextEnabled
, "applicationCacheEnabled" .= applicationCacheEnabled
, "browserConnectionEnabled" .= browserConnectionEnabled
, "cssSelectorsEnabled" .= cssSelectorsEnabled
, "webStorageEnabled" .= webStorageEnabled
, "rotatable" .= rotatable
, "acceptSslCerts" .= acceptSSLCerts
, "nativeEvents" .= nativeEvents
, "unexpectedAlertBehavior" .= unexpectedAlertBehavior
]
++ browserInfo
++ additionalCaps
where
browserInfo = case browser of
Firefox {..}
-> ["firefox_profile" .= ffProfile
,"loggingPrefs" .= object ["driver" .= ffLogPref]
,"firefox_binary" .= ffBinary
]
Chrome {..}
-> catMaybes [ opt "chrome.chromedriverVersion" chromeDriverVersion
, opt "chrome.binary" chromeBinary
]
++ ["chrome.switches" .= chromeOptions
,"chrome.extensions" .= chromeExtensions
]
IE {..}
-> ["ignoreProtectedModeSettings" .= ieIgnoreProtectedModeSettings
,"ignoreZoomSetting" .= ieIgnoreZoomSetting
,"initialBrowserUrl" .= ieInitialBrowserUrl
,"elementScrollBehavior" .= ieElementScrollBehavior
,"enablePersistentHover" .= ieEnablePersistentHover
,"enableElementCacheCleanup" .= ieEnableElementCacheCleanup
,"requireWindowFocus" .= ieRequireWindowFocus
,"browserAttachTimeout" .= ieBrowserAttachTimeout
,"logFile" .= ieLogFile
,"logLevel" .= ieLogLevel
,"host" .= ieHost
,"extractPath" .= ieExtractPath
,"silent" .= ieSilent
,"forceCreateProcess" .= ieForceCreateProcess
,"internetExplorerSwitches" .= ieSwitches
]
Opera{..}
-> catMaybes [ opt "opera.binary" operaBinary
, opt "opera.display" operaDisplay
, opt "opera.product" operaProduct
, opt "opera.launcher" operaLauncher
, opt "opera.host" operaHost
, opt "opera.logging.file" operaLogFile
]
++ ["opera.detatch" .= operaDetach
,"opera.no_quit" .= operaDetach
,"opera.autostart" .= operaAutoStart
, "opera.idle" .= operaIdle
,"opera.port" .= fromMaybe (1) operaPort
,"opera.arguments" .= operaOptions
,"opera.logging.level" .= operaLogPref
]
_ -> []
where
opt k = fmap (k .=)
instance FromJSON Capabilities where
parseJSON (Object o) = do
browser <- req "browserName"
Capabilities <$> getBrowserCaps browser
<*> opt "version" Nothing
<*> req "platform"
<*> opt "proxy" NoProxy
<*> b "javascriptEnabled"
<*> b "takesScreenshot"
<*> b "handlesAlerts"
<*> b "databaseEnabled"
<*> b "locationContextEnabled"
<*> b "applicationCacheEnabled"
<*> b "browserConnectionEnabled"
<*> b "cssSelectorEnabled"
<*> b "webStorageEnabled"
<*> b "rotatable"
<*> b "acceptSslCerts"
<*> b "nativeEvents"
<*> opt "unexpectedAlertBehaviour" Nothing
<*> pure (additionalCapabilities browser)
where
req :: FromJSON a => Text -> Parser a
req = (o .:)
opt :: FromJSON a => Text -> a -> Parser a
opt k d = o .:? k .!= d
b :: Text -> Parser (Maybe Bool)
b k = opt k Nothing
additionalCapabilities = HM.toList . foldr HM.delete o . knownCapabilities
knownCapabilities browser =
["browserName", "version", "platform", "proxy"
,"javascriptEnabled", "takesScreenshot", "handlesAlerts"
,"databaseEnabled", "locationContextEnabled"
,"applicationCacheEnabled", "browserConnectionEnabled"
, "cssSelectorEnabled","webStorageEnabled", "rotatable"
, "acceptSslCerts", "nativeEvents", "unexpectedBrowserBehaviour"]
++ case browser of
Firefox {} -> ["firefox_profile", "loggingPrefs", "firefox_binary"]
Chrome {} -> ["chrome.chromedriverVersion", "chrome.extensions", "chrome.switches", "chrome.extensions"]
IE {} -> ["ignoreProtectedModeSettings", "ignoreZoomSettings", "initialBrowserUrl", "elementScrollBehavior"
,"enablePersistentHover", "enableElementCacheCleanup", "requireWindowFocus", "browserAttachTimeout"
,"logFile", "logLevel", "host", "extractPath", "silent", "forceCreateProcess", "internetExplorerSwitches"]
Opera {} -> ["opera.binary", "opera.product", "opera.no_quit", "opera.autostart", "opera.idle", "opera.display"
,"opera.launcher", "opera.port", "opera.host", "opera.arguments", "opera.logging.file", "opera.logging.level"]
_ -> []
getBrowserCaps browser =
case browser of
Firefox {} -> Firefox <$> opt "firefox_profile" Nothing
<*> opt "loggingPrefs" def
<*> opt "firefox_binary" Nothing
Chrome {} -> Chrome <$> opt "chrome.chromedriverVersion" Nothing
<*> opt "chrome.extensions" Nothing
<*> opt "chrome.switches" []
<*> opt "chrome.extensions" []
IE {} -> IE <$> opt "ignoreProtectedModeSettings" True
<*> opt "ignoreZoomSettings" False
<*> opt "initialBrowserUrl" Nothing
<*> opt "elementScrollBehavior" def
<*> opt "enablePersistentHover" True
<*> opt "enableElementCacheCleanup" True
<*> opt "requireWindowFocus" False
<*> opt "browserAttachTimeout" 0
<*> opt "logFile" Nothing
<*> opt "logLevel" def
<*> opt "host" Nothing
<*> opt "extractPath" Nothing
<*> opt "silent" False
<*> opt "forceCreateProcess" False
<*> opt "internetExplorerSwitches" Nothing
Opera {} -> Opera <$> opt "opera.binary" Nothing
<*> opt "opera.product" Nothing
<*> opt "opera.no_quit" False
<*> opt "opera.autostart" True
<*> opt "opera.idle" False
<*> opt "opera.display" Nothing
<*> opt "opera.launcher" Nothing
<*> opt "opera.port" (Just 0)
<*> opt "opera.host" Nothing
<*> opt "opera.arguments" Nothing
<*> opt "opera.logging.file" Nothing
<*> opt "opera.logging.level" def
_ -> return browser
parseJSON v = typeMismatch "Capabilities" v
data Browser = Firefox {
ffProfile :: Maybe (PreparedProfile Firefox)
, ffLogPref :: LogLevel
, ffBinary :: Maybe FilePath
}
| Chrome {
chromeDriverVersion :: Maybe String
, chromeBinary :: Maybe FilePath
, chromeOptions :: [String]
, chromeExtensions :: [ChromeExtension]
}
| IE {
ieIgnoreProtectedModeSettings :: Bool
, ieIgnoreZoomSetting :: Bool
, ieInitialBrowserUrl :: Maybe Text
, ieElementScrollBehavior :: IEElementScrollBehavior
, ieEnablePersistentHover :: Bool
, ieEnableElementCacheCleanup :: Bool
, ieRequireWindowFocus :: Bool
, ieBrowserAttachTimeout :: Integer
, ieLogFile :: Maybe FilePath
, ieLogLevel :: IELogLevel
, ieHost :: Maybe Text
, ieExtractPath :: Maybe Text
, ieSilent :: Bool
, ieForceCreateProcess :: Bool
, ieSwitches :: Maybe Text
}
| Opera {
operaBinary :: Maybe FilePath
, operaProduct :: Maybe String
, operaDetach :: Bool
, operaAutoStart :: Bool
, operaIdle :: Bool
, operaDisplay :: Maybe Int
, operaLauncher :: Maybe FilePath
, operaPort :: Maybe Word16
, operaHost :: Maybe String
, operaOptions :: Maybe String
, operaLogFile :: Maybe FilePath
, operaLogPref :: LogLevel
}
| HTMLUnit
| IPhone
| IPad
| Android
| Browser Text
deriving (Eq, Show)
instance Default Browser where
def = firefox
instance ToJSON Browser where
toJSON Firefox {} = String "firefox"
toJSON Chrome {} = String "chrome"
toJSON Opera {} = String "opera"
toJSON IE {} = String "internet explorer"
toJSON (Browser b) = String b
toJSON b = String . toLower . fromString . show $ b
instance FromJSON Browser where
parseJSON (String jStr) = case toLower jStr of
"firefox" -> return firefox
"chrome" -> return chrome
"internet explorer" -> return ie
"opera" -> return opera
"iphone" -> return iPhone
"ipad" -> return iPad
"android" -> return android
"htmlunit" -> return htmlUnit
other -> return (Browser other)
parseJSON v = typeMismatch "Browser" v
firefox :: Browser
firefox = Firefox Nothing def Nothing
chrome :: Browser
chrome = Chrome Nothing Nothing [] []
ie :: Browser
ie = IE { ieIgnoreProtectedModeSettings = True
, ieIgnoreZoomSetting = False
, ieInitialBrowserUrl = Nothing
, ieElementScrollBehavior = def
, ieEnablePersistentHover = True
, ieEnableElementCacheCleanup = True
, ieRequireWindowFocus = False
, ieBrowserAttachTimeout = 0
, ieLogFile = Nothing
, ieLogLevel = def
, ieHost = Nothing
, ieExtractPath = Nothing
, ieSilent = False
, ieForceCreateProcess = False
, ieSwitches = Nothing
}
opera :: Browser
opera = Opera { operaBinary = Nothing
, operaProduct = Nothing
, operaDetach = False
, operaAutoStart = True
, operaDisplay = Nothing
, operaIdle = False
, operaLauncher = Nothing
, operaHost = Nothing
, operaPort = Just 0
, operaOptions = Nothing
, operaLogFile = Nothing
, operaLogPref = def
}
htmlUnit :: Browser
htmlUnit = HTMLUnit
iPhone :: Browser
iPhone = IPhone
iPad :: Browser
iPad = IPad
android :: Browser
android = Android
data Platform = Windows | XP | Vista | Mac | Linux | Unix | Any
deriving (Eq, Show, Ord, Bounded, Enum)
instance ToJSON Platform where
toJSON = String . toUpper . fromString . show
instance FromJSON Platform where
parseJSON (String jStr) = case toLower jStr of
"windows" -> return Windows
"xp" -> return XP
"vista" -> return Vista
"mac" -> return Mac
"linux" -> return Linux
"unix" -> return Unix
"any" -> return Any
err -> fail $ "Invalid Platform string " ++ show err
parseJSON v = typeMismatch "Platform" v
data ProxyType = NoProxy
| UseSystemSettings
| AutoDetect
| PAC { autoConfigUrl :: String }
| Manual { ftpProxy :: String
, sslProxy :: String
, httpProxy :: String
}
deriving (Eq, Show)
instance FromJSON ProxyType where
parseJSON (Object obj) = do
pTyp <- f "proxyType"
case toLower pTyp of
"direct" -> return NoProxy
"system" -> return UseSystemSettings
"pac" -> PAC <$> f "autoConfigUrl"
"manual" -> Manual <$> f "ftpProxy"
<*> f "sslProxy"
<*> f "httpProxy"
_ -> fail $ "Invalid ProxyType " ++ show pTyp
where
f :: FromJSON a => Text -> Parser a
f = (obj .:)
parseJSON v = typeMismatch "ProxyType" v
instance ToJSON ProxyType where
toJSON pt = object $ case pt of
NoProxy ->
["proxyType" .= ("DIRECT" :: String)]
UseSystemSettings ->
["proxyType" .= ("SYSTEM" :: String)]
AutoDetect ->
["proxyType" .= ("AUTODETECT" :: String)]
PAC{autoConfigUrl = url} ->
["proxyType" .= ("PAC" :: String)
,"autoConfigUrl" .= url
]
Manual{ftpProxy = ftp, sslProxy = ssl, httpProxy = http} ->
["proxyType" .= ("MANUAL" :: String)
,"ftpProxy" .= ftp
,"sslProxy" .= ssl
,"httpProxy" .= http
]
data UnexpectedAlertBehavior = AcceptAlert | DismissAlert | IgnoreAlert
deriving (Bounded, Enum, Eq, Ord, Read, Show)
instance ToJSON UnexpectedAlertBehavior where
toJSON AcceptAlert = String "accept"
toJSON DismissAlert = String "dismiss"
toJSON IgnoreAlert = String "ignore"
instance FromJSON UnexpectedAlertBehavior where
parseJSON (String s) =
return $ case s of
"accept" -> AcceptAlert
"dismiss" -> DismissAlert
"ignore" -> IgnoreAlert
err -> throw . BadJSON
$ "Invalid string value for UnexpectedAlertBehavior: " ++ show err
parseJSON v = typeMismatch "UnexpectedAlertBehavior" v
data LogLevel = LogOff | LogSevere | LogWarning | LogInfo | LogConfig
| LogFine | LogFiner | LogFinest | LogAll
deriving (Eq, Show, Read, Ord, Bounded, Enum)
instance Default LogLevel where
def = LogInfo
instance ToJSON LogLevel where
toJSON p= String $ case p of
LogOff -> "OFF"
LogSevere -> "SEVERE"
LogWarning -> "WARNING"
LogInfo -> "INFO"
LogConfig -> "CONFIG"
LogFine -> "FINE"
LogFiner -> "FINER"
LogFinest -> "FINEST"
LogAll -> "ALL"
instance FromJSON LogLevel where
parseJSON (String s) = return $ case s of
"OFF" -> LogOff
"SEVERE" -> LogSevere
"WARNING" -> LogWarning
"INFO" -> LogInfo
"CONFIG" -> LogConfig
"FINE" -> LogFine
"FINER" -> LogFiner
"FINEST" -> LogFinest
"ALL" -> LogAll
_ -> throw . BadJSON $ "Invalid logging preference: " ++ show s
parseJSON other = typeMismatch "LogLevel" other
data IELogLevel = IELogTrace | IELogDebug | IELogInfo | IELogWarn | IELogError
| IELogFatal
deriving (Eq, Show, Read, Ord, Bounded, Enum)
instance Default IELogLevel where
def = IELogFatal
instance ToJSON IELogLevel where
toJSON p= String $ case p of
IELogTrace -> "TRACE"
IELogDebug -> "DEBUG"
IELogInfo -> "INFO"
IELogWarn -> "WARN"
IELogError -> "ERROR"
IELogFatal -> "FATAL"
instance FromJSON IELogLevel where
parseJSON (String s) = return $ case s of
"TRACE" -> IELogTrace
"DEBIG" -> IELogDebug
"INFO" -> IELogInfo
"WARN" -> IELogWarn
"ERROR" -> IELogError
"FATAL" -> IELogFatal
_ -> throw . BadJSON $ "Invalid logging preference: " ++ show s
parseJSON other = typeMismatch "IELogLevel" other
data IEElementScrollBehavior = AlignTop | AlignBottom
deriving (Eq, Ord, Show, Read, Enum, Bounded)
instance Default IEElementScrollBehavior where
def = AlignTop
instance ToJSON IEElementScrollBehavior where
toJSON AlignTop = toJSON (0 :: Int)
toJSON AlignBottom = toJSON (1 :: Int)
instance FromJSON IEElementScrollBehavior where
parseJSON v = do
n <- parseJSON v
case n :: Integer of
0 -> return AlignTop
1 -> return AlignBottom
_ -> fail $ "Invalid integer for IEElementScrollBehavior: " ++ show n