webdriver 0.5.1 → 0.5.2
raw patch · 12 files changed
+442/−92 lines, 12 filesdep +paralleldep +webdriverdep ~aesondep ~basedep ~filesystem-trees
Dependencies added: parallel, webdriver
Dependency ranges changed: aeson, base, filesystem-trees, text
Files
- CHANGELOG.md +20/−2
- src/Test/WebDriver/Capabilities.hs +266/−37
- src/Test/WebDriver/Classes.hs +10/−5
- src/Test/WebDriver/Commands.hs +45/−19
- src/Test/WebDriver/Commands/Internal.hs +4/−3
- src/Test/WebDriver/Common/Profile.hs +1/−1
- src/Test/WebDriver/Internal.hs +30/−12
- src/Test/WebDriver/Monad.hs +2/−2
- src/Test/WebDriver/Types.hs +4/−7
- src/Test/WebDriver/Utils.hs +8/−0
- test/search-baidu.hs +39/−0
- webdriver.cabal +13/−4
CHANGELOG.md view
@@ -1,14 +1,32 @@ #Change Log -##upcoming release+##0.5.2 ###API changes+* added many new Internet Explorer capabilities+* added additionalCaps to Capabilities, which allows support for non-standard capabilities+* Browser type now supports non-standard browsers via the new Browser constructor+* added support for the new unexpectedAlertBehaviour capability++###new features+* new command getApplicationCacheStatus supported+* error reporting for unknown commands now slightly improved++###bug fixes+* internal request URIs are now properly percent-encoded+* improved handling of browser-specific capabilities+* fixed incompatability with new session creation protocol changes introduced in selenium 2.35+* updated to work with Aeson 0.6.2 and onward++##hs-webdriver 0.5.1+###API changes * Test.WebDriver.Internal.FailedCommandInfo now stores screenshots as lazy bytestrings * Test.WebDriver.Common.Profile now stores PreparedProfile as a lazy bytestring * Test.WebDriver.Chrome.Extension now stores ChromeExtension as a lazy bytestring * The LogPref type has been renamed to LogLevel to reflect its use within the new log interface ###new features-* a new log interface as specified by webdriver standard. This includes the functions getLogs and getLogTypes, and the types LogType and LogEntry. +* a new log interface as specified by the webdriver standard. This includes the functions getLogs and getLogTypes, and the types LogType and LogEntry. +* waitWhile and waitUntil now show more detailed information about why an explicit wait timed out. ##hs-webdriver 0.5.0.1 ###bug fixes
src/Test/WebDriver/Capabilities.hs view
@@ -7,7 +7,8 @@ import Test.WebDriver.JSON import Data.Aeson-import Data.Aeson.Types (Parser, typeMismatch)+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(..))@@ -17,7 +18,7 @@ import Control.Applicative import Control.Exception.Lifted (throw)-+ {- |A structure describing the capabilities of a session. This record serves dual roles. @@ -75,6 +76,10 @@ -- |Whether the session is capable of generating native OS -- events when simulating user input. , nativeEvents :: Maybe Bool+ -- |How the session should handle unexpected alerts.+ , unexpectedAlertBehavior :: Maybe UnexpectedAlertBehavior+ -- |A list of ('Text', 'Value') pairs specifying additional non-standard capabilities.+ , additionalCaps :: [Pair] } deriving (Eq, Show) instance Default Capabilities where@@ -94,17 +99,19 @@ , acceptSSLCerts = Nothing , nativeEvents = Nothing , proxy = UseSystemSettings+ , unexpectedAlertBehavior = Nothing+ , additionalCaps = [] } -- |Default capabilities. This is the same as the 'Default' instance, but with -- less polymorphism. By default, we use 'firefox' of an unspecified 'version' -- with default system-wide 'proxy' settings on whatever 'platform' is available--- . All Maybe Bool capabilities are set to Nothing (no preference).+-- . All 'Maybe' capabilities are set to 'Nothing' (no preference). defaultCaps :: Capabilities defaultCaps = def --- |Same as 'defaultCaps', but with all Maybe Bool capabilities set to--- Just True.+-- |Same as 'defaultCaps', but with all 'Maybe' 'Bool' capabilities set to+-- 'Just' 'True'. allCaps :: Capabilities allCaps = defaultCaps { javascriptEnabled = Just True , takesScreenshot = Just True@@ -139,7 +146,10 @@ , "rotatable" .= rotatable , "acceptSslCerts" .= acceptSSLCerts , "nativeEvents" .= nativeEvents- ] ++ browserInfo+ , "unexpectedAlertBehavior" .= unexpectedAlertBehavior+ ] + ++ browserInfo+ ++ additionalCaps where browserInfo = case browser of Firefox {..}@@ -155,8 +165,21 @@ ,"chrome.extensions" .= chromeExtensions ] IE {..}- -> ["IgnoreProtectedModeSettings" .= ignoreProtectedModeSettings- --,"useLegacyInternalServer" .= u+ -> ["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@@ -183,28 +206,92 @@ 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+ 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 --some helpful JSON accessor shorthands + req :: FromJSON a => Text -> Parser a req = (o .:) -- required field opt :: FromJSON a => Text -> a -> Parser a opt k d = o .:? k .!= d -- optional field b :: Text -> Parser (Maybe Bool) b k = opt k Nothing -- Maybe Bool field+ + -- produce additionalCaps by removing known capabilities from the JSON object+ 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 -- |This constructor simultaneously specifies which browser the session will@@ -243,8 +330,63 @@ -- not set, and protected mode settings are not the same for -- all zones, an exception will be thrown on driver -- construction.- ignoreProtectedModeSettings :: Bool- --, useLegacyInternalServer :: Bool+ ieIgnoreProtectedModeSettings :: Bool+ -- |Indicates whether to skip the check that the browser's zoom+ -- level is set to 100%. Value is set to false by default.+ , ieIgnoreZoomSetting :: Bool+ -- |Allows the user to specify the initial URL loaded when IE + -- starts. Intended to be used with ignoreProtectedModeSettings+ -- to allow the user to initialize IE in the proper Protected Mode + -- zone. Using this capability may cause browser instability or+ -- flaky and unresponsive code. Only \"best effort\" support is+ -- provided when using this capability.+ , ieInitialBrowserUrl :: Maybe Text+ -- |Allows the user to specify whether elements are scrolled into + -- the viewport for interaction to align with the top or bottom + -- of the viewport. The default value is to align with the top of + -- the viewport.+ , ieElementScrollBehavior :: IEElementScrollBehavior+ -- |Determines whether persistent hovering is enabled (true by + -- default). Persistent hovering is achieved by continuously firing + -- mouse over events at the last location the mouse cursor has been + -- moved to.+ , ieEnablePersistentHover :: Bool+ -- |Determines whether the driver should attempt to remove obsolete + -- elements from the element cache on page navigation (true by + -- default). This is to help manage the IE driver's memory footprint+ -- , removing references to invalid elements.+ , ieEnableElementCacheCleanup :: Bool+ -- |Determines whether to require that the IE window have focus + -- before performing any user interaction operations (mouse or + -- keyboard events). This capability is false by default, but+ -- delivers much more accurate native events interactions.+ , ieRequireWindowFocus :: Bool+ -- |The timeout, in milliseconds, that the driver will attempt to+ -- locate and attach to a newly opened instance of Internet Explorer+ -- . The default is zero, which indicates waiting indefinitely.+ , ieBrowserAttachTimeout :: Integer+ -- |The path to file where server should write log messages to. + -- By default it writes to stdout.+ , ieLogFile :: Maybe FilePath+ -- |The log level used by the server. Defaults to 'IELogFatal'+ , ieLogLevel :: IELogLevel+ -- |The address of the host adapter on which the server will listen + -- for commands.+ , ieHost :: Maybe Text+ -- |The path to the directory used to extract supporting files used + -- by the server. Defaults to the TEMP directory if not specified.+ , ieExtractPath :: Maybe Text+ -- |Suppresses diagnostic output when the server is started.+ , ieSilent :: Bool+ -- |Forces launching Internet Explorer using the CreateProcess API. + -- If this option is not specified, IE is launched using the+ -- IELaunchURL, if it is available. For IE 8 and above, this option + -- requires the TabProcGrowth registry value to be set to 0.+ , ieForceCreateProcess :: Bool+ -- |Specifies command-line switches with which to launch Internet + -- Explorer. This is only valid when used with the + -- forceCreateProcess.+ , ieSwitches :: Maybe Text } | Opera { -- |Server-side path to the Opera binary operaBinary :: Maybe FilePath@@ -283,7 +425,7 @@ -- starting Opera manually you won't need this. , operaHost :: Maybe String -- |Command-line arguments to pass to Opera.- , operaOptions :: String+ , operaOptions :: Maybe String -- |Where to send the log output. If Nothing, logging is -- disabled. , operaLogFile :: Maybe FilePath@@ -294,6 +436,8 @@ | IPhone | IPad | Android+ -- |some other browser, specified by a string name+ | Browser Text deriving (Eq, Show) instance Default Browser where@@ -301,11 +445,12 @@ 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+ 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@@ -318,7 +463,7 @@ "ipad" -> return iPad "android" -> return android "htmlunit" -> return htmlUnit- err -> fail $ "Invalid Browser string " ++ show err+ other -> return (Browser other) parseJSON v = typeMismatch "Browser" v @@ -332,9 +477,25 @@ chrome :: Browser chrome = Chrome Nothing Nothing [] [] --- |Default IE settings. 'ignoreProtectedModeSettings' is set to True.+-- |Default IE settings. See the 'IE' constructor for more details on +-- individual defaults ie :: Browser-ie = IE True+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+ } -- |Default Opera settings. See the 'Opera' constructor for more details on -- individual defaults.@@ -350,7 +511,7 @@ , operaLauncher = Nothing , operaHost = Nothing , operaPort = Just 0- , operaOptions = []+ , operaOptions = Nothing , operaLogFile = Nothing , operaLogPref = def }@@ -439,6 +600,24 @@ ,"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+ -- |Indicates a log verbosity level. Used in 'Firefox' and 'Opera' configuration. data LogLevel = LogOff | LogSevere | LogWarning | LogInfo | LogConfig | LogFine | LogFiner | LogFinest | LogAll@@ -472,3 +651,53 @@ "ALL" -> LogAll _ -> throw . BadJSON $ "Invalid logging preference: " ++ show s parseJSON other = typeMismatch "LogLevel" other+ ++-- |Logging levels for Internet Explorer+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++-- |Specifies how elements scroll into the viewport. (see 'ieElementScrollBehavior')+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+
src/Test/WebDriver/Classes.hs view
@@ -12,6 +12,8 @@ --import Test.WebDriver.Internal import Data.Aeson import Network.HTTP (RequestMethod(..))+import Network.HTTP.Base (Request)+import Data.ByteString.Lazy (ByteString) import Data.Text (Text) @@ -77,13 +79,16 @@ -- and closed automatically with -- 'Test.WebDriver.runSession' , wdSessId :: Maybe SessionId- } deriving (Eq, Show)+ -- |The last HTTP request issued by this session, if any. + , lastHTTPRequest :: Maybe (Request ByteString)+ } deriving (Show) instance Default WDSession where- def = WDSession { wdHost = "127.0.0.1"- , wdPort = 4444- , wdBasePath = "/wd/hub"- , wdSessId = Nothing+ def = WDSession { wdHost = "127.0.0.1"+ , wdPort = 4444+ , wdBasePath = "/wd/hub"+ , wdSessId = Nothing+ , lastHTTPRequest = Nothing } {- |A default session connects to localhost on port 4444, and hasn't been
src/Test/WebDriver/Commands.hs view
@@ -47,6 +47,9 @@ -- * HTML 5 Web Storage , WebStorageType(..), storageSize, getAllKeys, deleteAllKeys , getKey, setKey, deleteKey+ -- * HTML 5 Application Cache+ , ApplicationCacheStatus(..)+ , getApplicationCacheStatus -- * Mobile device support -- ** Screen orientation , Orientation(..)@@ -75,12 +78,13 @@ import Test.WebDriver.JSON import Test.WebDriver.Capabilities import Test.WebDriver.Internal+import Test.WebDriver.Utils (urlEncode) import Data.Aeson import Data.Aeson.Types import Data.Aeson.TH import qualified Data.Text as T-import Data.Text (Text, splitOn, append, toUpper, toLower)+import Data.Text (Text, append, toUpper, toLower) import Data.ByteString.Base64.Lazy as B64 import Data.ByteString.Lazy as LBS (ByteString) import Network.URI hiding (path) -- suppresses warnings@@ -90,26 +94,28 @@ import Control.Monad.State.Strict import Control.Monad.Base import Control.Exception (SomeException)-import Control.Exception.Lifted (throwIO, catch, handle)+import Control.Exception.Lifted (throwIO, handle)+import qualified Control.Exception.Lifted as L import Data.Word import Data.String (fromString) import Data.Maybe (fromMaybe) import qualified Data.Char as C -import Prelude hiding (catch) + -- |Convenience function to handle webdriver commands with no return value noReturn :: WebDriver wd => wd NoReturn -> wd () noReturn = void --- |Create a new session with the given 'Capabilities'. This command--- resets the current session ID to that of the new session.+-- |Convenience function to ignore result of a webdriver command+ignoreReturn :: WebDriver wd => wd Value -> wd ()+ignoreReturn = void++-- |Create a new session with the given 'Capabilities'. createSession :: WebDriver wd => Capabilities -> wd WDSession createSession caps = do- sessUrl <- doCommand POST "/session" . single "desiredCapabilities" $ caps- let sessId = SessionId . last . filter (not . T.null) . splitOn "/" $ sessUrl- modifySession $ \sess -> sess {wdSessId = Just sessId}+ ignoreReturn . doCommand POST "/session" . single "desiredCapabilities" $ caps getSession -- |Retrieve a list of active sessions and their 'Capabilities'.@@ -132,7 +138,7 @@ setImplicitWait :: WebDriver wd => Integer -> wd () setImplicitWait ms = noReturn $ doSessCommand POST "/timeouts/implicit_wait" (object msField)- `catch` \(_ :: SomeException) ->+ `L.catch` \(_ :: SomeException) -> doSessCommand POST "/timeouts" (object allFields) where msField = ["ms" .= ms] allFields = ["type" .= ("implicit" :: String)] ++ msField@@ -142,7 +148,7 @@ setScriptTimeout :: WebDriver wd => Integer -> wd () setScriptTimeout ms = noReturn $ doSessCommand POST "/timeouts/async_script" (object msField)- `catch` \(_ :: SomeException) ->+ `L.catch` \(_ :: SomeException) -> doSessCommand POST "/timeouts" (object allFields) where msField = ["ms" .= ms] allFields = ["type" .= ("script" :: String)] ++ msField@@ -360,7 +366,7 @@ -- current page. deleteCookie :: WebDriver wd => Cookie -> wd () deleteCookie c = - noReturn $ doSessCommand DELETE ("/cookie/" `append` cookName c) Null+ noReturn $ doSessCommand DELETE ("/cookie/" `append` urlEncode (cookName c)) Null -- |Delete all visible cookies on the current page. deleteVisibleCookies :: WebDriver wd => wd ()@@ -471,11 +477,11 @@ -- |Retrieve the value of an element's attribute attr :: WebDriver wd => Element -> Text -> wd (Maybe Text)-attr e t = doElemCommand GET e ("/attribute/" `append` t) Null+attr e t = doElemCommand GET e ("/attribute/" `append` urlEncode t) Null -- |Retrieve the value of an element's computed CSS property cssProp :: WebDriver wd => Element -> Text -> wd (Maybe Text)-cssProp e t = doElemCommand GET e ("/css/" `append` t) Null+cssProp e t = doElemCommand GET e ("/css/" `append` urlEncode t) Null -- |Retrieve an element's current position. elemPos :: WebDriver wd => Element -> wd (Int, Int)@@ -489,7 +495,7 @@ infix 4 <==> -- |Determines if two element identifiers refer to the same element. (<==>) :: WebDriver wd => Element -> Element -> wd Bool-e1 <==> (Element e2) = doElemCommand GET e1 ("/equals/" `append` e2) Null+e1 <==> (Element e2) = doElemCommand GET e1 ("/equals/" `append` urlEncode e2) Null -- |Determines if two element identifiers refer to different elements. infix 4 </=>@@ -709,7 +715,7 @@ -- Unset keys result in empty strings, since the Web Storage spec -- makes no distinction between the empty string and an undefined value. getKey :: WebDriver wd => WebStorageType -> Text -> wd Text-getKey s k = doStorageCommand GET s ("/key/" `T.append` k) Null+getKey s k = doStorageCommand GET s ("/key/" `T.append` urlEncode k) Null -- |Set a key in the given web storage area. setKey :: WebDriver wd => WebStorageType -> Text -> Text -> wd Text@@ -717,7 +723,7 @@ "value" .= v ] -- |Delete a key in the given web storage area. deleteKey :: WebDriver wd => WebStorageType -> Text -> wd ()-deleteKey s k = noReturn $ doStorageCommand POST s ("/key/" `T.append` k) Null+deleteKey s k = noReturn $ doStorageCommand POST s ("/key/" `T.append` urlEncode k) Null -- |A wrapper around 'doStorageCommand' to create web storage URLs. doStorageCommand :: (WebDriver wd, ToJSON a, FromJSON b) =>@@ -731,7 +737,7 @@ -- about this object see -- <http://code.google.com/p/selenium/wiki/JsonWireProtocol#/status> serverStatus :: (WebDriver wd) => wd Value -- todo: make this a record type-serverStatus = doCommand GET "/status" ()+serverStatus = doCommand GET "/status" Null -- |A record that represents a single log entry. data LogEntry = @@ -754,13 +760,33 @@ type LogType = String -- |Retrieve the log buffer for a given log type. The server-side log buffer is reset after each request.+--+-- Which log types are available is server defined, but the wire protocol lists these as common log types:+-- client, driver, browser, server getLogs :: WebDriver wd => LogType -> wd [LogEntry] getLogs t = doSessCommand POST "/log" . object $ ["type" .= t] -- |Get a list of available log types. getLogTypes :: WebDriver wd => wd [LogType]-getLogTypes = doSessCommand GET "/log/types" ()+getLogTypes = doSessCommand GET "/log/types" Null +data ApplicationCacheStatus = Uncached | Idle | Checking | Downloading | UpdateReady | Obsolete deriving (Eq, Enum, Bounded, Ord, Show, Read)++instance FromJSON ApplicationCacheStatus where+ parseJSON val = do+ n <- parseJSON val+ case n :: Integer of+ 0 -> return Uncached+ 1 -> return Idle+ 2 -> return Checking+ 3 -> return Downloading+ 4 -> return UpdateReady+ 5 -> return Obsolete+ err -> fail $ "Invalid JSON for ApplicationCacheStatus: " ++ show err+ +getApplicationCacheStatus :: (WebDriver wd) => wd ApplicationCacheStatus+getApplicationCacheStatus = doSessCommand GET "/application_cache/status" Null+ -- Moving this closer to the definition of Cookie seems to cause strange compile -- errors, so I'm leaving it here for now.-$( deriveToJSON (map C.toLower . drop 4) ''Cookie )+$( deriveToJSON (defaultOptions{fieldLabelModifier = map C.toLower . drop 4}) ''Cookie )
src/Test/WebDriver/Commands/Internal.hs view
@@ -17,6 +17,7 @@ ) where import Test.WebDriver.Classes+import Test.WebDriver.Utils (urlEncode) import Data.Aeson import Data.Aeson.Types@@ -72,7 +73,7 @@ msg = "doSessCommand: No session ID found for relative URL " ++ show path Just (SessionId sId) -> doCommand method- (T.concat ["/session/", sId, path]) args+ (T.concat ["/session/", urlEncode sId, path]) args -- |A wrapper around 'doSessCommand' to create element URLs. -- For example, passing a URL of "/active" will expand to@@ -81,7 +82,7 @@ doElemCommand :: (WebDriver wd, ToJSON a, FromJSON b) => RequestMethod -> Element -> Text -> a -> wd b doElemCommand m (Element e) path a =- doSessCommand m (T.concat ["/element/", e, path]) a+ doSessCommand m (T.concat ["/element/", urlEncode e, path]) a -- |A wrapper around 'doSessCommand' to create window handle URLS. -- For example, passing a URL of \"/size\" will expand to@@ -90,4 +91,4 @@ doWinCommand :: (WebDriver wd, ToJSON a, FromJSON b) => RequestMethod -> WindowHandle -> Text -> a -> wd b doWinCommand m (WindowHandle w) path a =- doSessCommand m (T.concat ["/window/", w, path]) a+ doSessCommand m (T.concat ["/window/", urlEncode w, path]) a
src/Test/WebDriver/Common/Profile.hs view
@@ -62,7 +62,7 @@ -- there is one unique source path going to each -- destination path. profileFiles :: HM.HashMap FilePath FilePath- -- |A map of Firefox preferences. These are the settings+ -- |A map of profile preferences. These are the settings -- found in the profile's prefs.js, and entries found in -- about:config , profilePrefs :: HM.HashMap Text ProfilePref
src/Test/WebDriver/Internal.hs view
@@ -20,7 +20,7 @@ import Data.Aeson import Data.Aeson.Types (Parser, typeMismatch) -import Data.Text as T (Text, unpack)+import Data.Text as T (Text, unpack, splitOn, null) import Data.ByteString.Lazy.Char8 (ByteString) import Data.ByteString.Lazy.Char8 as LBS (length, unpack, null) import qualified Data.ByteString.Base64.Lazy as B64@@ -70,12 +70,16 @@ ] } r <- liftBase (simpleHTTP req) >>= either (throwIO . HTTPConnError) return+ modifySession $ \s -> s {lastHTTPRequest = Just req} -- update lastHTTPRequest field return r handleHTTPErr :: SessionState s => Response ByteString -> s () handleHTTPErr r@Response{rspBody = body, rspCode = code, rspReason = reason} = case code of- (4,_,_) -> err UnknownCommand+ (4,_,_) -> do+ lastReq <- lastHTTPRequest <$> getSession + throwIO . UnknownCommand . maybe reason show + $ lastReq (5,_,_) -> case findHeader HdrContentType r of Just ct@@ -97,15 +101,30 @@ case code of (2,0,4) -> noReturn (3,0,x)- | x `elem` [2,3] -> - fromJSON' =<< maybe statusErr (return . String . fromString)- (findHeader HdrLocation resp)- where- statusErr = throwIO . HTTPStatusUnknown code- $ (LBS.unpack body)- other+ | x `elem` [2,3] ->+ case findHeader HdrLocation resp of + Nothing -> throwIO . HTTPStatusUnknown code+ $ (LBS.unpack body)+ Just loc -> do+ let sessId = last . filter (not . T.null) . splitOn "/" . fromString $ loc+ modifySession $ \sess -> sess {wdSessId = Just (SessionId sessId)}+ fromJSON' . String $ sessId+ _ | LBS.null body -> noReturn- | otherwise -> fromJSON' . rspVal =<< parseJSON' body+ | otherwise -> do+ sess@WDSession { wdSessId = sessId} <- getSession -- get current session state+ WDResponse { rspSessId = sessId'+ , rspVal = val} <- parseJSON' body -- parse response body+ case (sessId, (==) <$> sessId <*> sessId') of+ -- if our monad has an uninitialized session ID, initialize it from the response object+ (Nothing, _) -> putSession sess { wdSessId = sessId' }+ -- if the response ID doesn't match our local ID, throw an error.+ (_, Just False) -> throwIO . ServerError $ "Server response session ID (" ++ show sessId' + ++ ") does not match local session ID (" ++ show sessId ++ ")"+ -- otherwise nothing needs to be done+ _ -> return ()+ fromJSON' val+ where noReturn = fromJSON' Null @@ -190,7 +209,7 @@ -- |This exception encapsulates a broad variety of exceptions that can -- occur when a command fails. data FailedCommand = FailedCommand FailedCommandType FailedCommandInfo- deriving (Eq, Show, Typeable)+ deriving (Show, Typeable) -- |The type of failed command exception that occured. data FailedCommandType = NoSuchElement@@ -237,7 +256,6 @@ -- |A stack trace of the exception. , errStack :: [StackFrame] }- deriving (Eq) -- |Provides a readable printout of the error information, useful for -- logging.
src/Test/WebDriver/Monad.hs view
@@ -19,8 +19,8 @@ import Control.Monad.CatchIO (MonadCatchIO) import Control.Applicative -{- |A monadic interface to the WebDriver server. This monad is a simple, strict-layer over 'IO', threading session information between sequential commands+{- |A monadic interface to the WebDriver server. This monad is simply a+ state monad transformer over 'IO', threading session information between sequential webdriver commands -} newtype WD a = WD (StateT WDSession IO a) deriving (Functor, Applicative, Monad, MonadIO, MonadCatchIO)
src/Test/WebDriver/Types.hs view
@@ -1,20 +1,15 @@-{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable,- TemplateHaskell, OverloadedStrings, ExistentialQuantification,- MultiParamTypeClasses, TypeFamilies,- RecordWildCards- #-} {-# OPTIONS_HADDOCK not-home #-} module Test.WebDriver.Types ( -- * WebDriver sessions WD(..), WDSession(..), defaultSession, SessionId(..) -- * Capabilities and configuration , Capabilities(..), defaultCaps, allCaps- , Platform(..), ProxyType(..)+ , Platform(..), ProxyType(..), UnexpectedAlertBehavior(..) -- ** Browser-specific configuration , Browser(..), -- ** Default settings for browsers firefox, chrome, ie, opera, iPhone, iPad, android- , LogLevel(..)+ , LogLevel(..), IELogLevel(..), IEElementScrollBehavior(..) -- * WebDriver objects and command-specific types , Element(..) , WindowHandle(..), currentWindow@@ -25,6 +20,8 @@ , Orientation(..) , MouseButton(..) , WebStorageType(..)+ , LogType, LogEntry(..)+ , ApplicationCacheStatus(..) -- * Exceptions , InvalidURL(..), NoSessionId(..), BadJSON(..) , HTTPStatusUnknown(..), HTTPConnError(..)
+ src/Test/WebDriver/Utils.hs view
@@ -0,0 +1,8 @@+module Test.WebDriver.Utils where++import Data.Text (Text)+import qualified Data.Text as T+import qualified Network.HTTP.Base as HTTP++urlEncode :: Text -> Text+urlEncode = T.pack . HTTP.urlEncode . T.unpack
+ test/search-baidu.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Control.Concurrent+import Control.Parallel+import Control.Monad (void)+import Data.List+import qualified Data.Text as T+import Test.WebDriver+import Test.WebDriver.Classes+import Test.WebDriver.Commands.Wait++capsChrome = defaultCaps { browser = chrome }+capsFF = defaultCaps++-- Have no fun with baidu but only cause it is loading fast than google in China.+--+baidu :: WD ()+baidu = openPage "http://www.baidu.com/"++searchBaidu :: WD Bool+searchBaidu = do+ searchBox <- findElem (ByName "wd")+ sendKeys "Cheese!" searchBox+ submit searchBox+ setImplicitWait 50+ waitUntil 2000 $ do+ title <- getTitle+ return ("cheese!" `T.isSuffixOf` title)++testCase c = void $ runSession defaultSession c (baidu >> searchBaidu)++testSuits = mapM_ testCase [capsFF, capsChrome]++main = do+ --testCase capsChrome `seq` testCase capsFF+ --mapM_ (forkOS . testCase) [capsFF, capsChrome]+ testSuits+ print "done"
webdriver.cabal view
@@ -1,6 +1,6 @@ Name: webdriver-Version: 0.5.1-Cabal-Version: >= 1.6+Version: 0.5.2+Cabal-Version: >= 1.8 License: BSD3 License-File: LICENSE Author: Adam Curtis@@ -30,7 +30,7 @@ hs-source-dirs: src ghc-options: -Wall build-depends: base == 4.*- , aeson >= 0.4 && < 0.7+ , aeson >= 0.6.2.0 && < 0.7 , HTTP >= 4000.1 && < 4000.3 , mtl >= 2.0 && < 2.2 , network == 2.4.*@@ -48,7 +48,7 @@ , vector >= 0.3 && < 0.11 , lifted-base >= 0.1 && < 0.3 , MonadCatchIO-transformers >= 0.3 && < 0.4- , filesystem-trees >= 0.1.0.2 && < 0.2+ , filesystem-trees >= 0.1.0.5 && < 0.2 , data-default >= 0.2 && < 1.0 , temporary >= 1.0 && < 2.0 , base64-bytestring >= 1.0 && < 1.1@@ -67,6 +67,15 @@ Test.WebDriver.Capabilities Test.WebDriver.Types Test.WebDriver.JSON+ Test.WebDriver.Utils other-modules: Test.WebDriver.Internal +Test-Suite test-search-baidu+ type: exitcode-stdio-1.0+ main-is: test/search-baidu.hs+ ghc-options: -threaded+ build-depends: base,+ webdriver,+ text,+ parallel