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)
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
} 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
}
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
] ++ browserInfo
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" .= ignoreProtectedModeSettings
]
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) = Capabilities <$> req "browserName"
<*> 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"
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
parseJSON v = typeMismatch "Capabilities" v
data Browser = Firefox {
ffProfile :: Maybe (PreparedProfile Firefox)
, ffLogPref :: LogPref
, ffBinary :: Maybe FilePath
}
| Chrome {
chromeDriverVersion :: Maybe String
, chromeBinary :: Maybe FilePath
, chromeOptions :: [String]
, chromeExtensions :: [ChromeExtension]
}
| IE {
ignoreProtectedModeSettings :: Bool
}
| 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 :: String
, operaLogFile :: Maybe FilePath
, operaLogPref :: LogPref
}
| HTMLUnit
| IPhone
| IPad
| Android
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 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
err -> fail $ "Invalid Browser string " ++ show err
parseJSON v = typeMismatch "Browser" v
firefox :: Browser
firefox = Firefox Nothing def Nothing
chrome :: Browser
chrome = Chrome Nothing Nothing [] []
ie :: Browser
ie = IE True
opera :: Browser
opera = Opera { operaBinary = Nothing
, operaProduct = Nothing
, operaDetach = False
, operaAutoStart = True
, operaDisplay = Nothing
, operaIdle = False
, operaLauncher = Nothing
, operaHost = Nothing
, operaPort = Just 0
, operaOptions = []
, 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 LogPref = LogOff | LogSevere | LogWarning | LogInfo | LogConfig
| LogFine | LogFiner | LogFinest | LogAll
deriving (Eq, Show, Ord, Bounded, Enum)
instance Default LogPref where
def = LogInfo
instance ToJSON LogPref 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 LogPref 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 "LogPref" other