webdriver-snoy (empty) → 0.6.0.2
raw patch · 25 files changed
+3670/−0 lines, 25 filesdep +aesondep +attoparsecdep +basesetup-changed
Dependencies added: aeson, attoparsec, base, base64-bytestring, bytestring, cond, data-default, directory, directory-tree, exceptions, filepath, http-client, http-types, lifted-base, monad-control, mtl, network, parallel, scientific, temporary, text, time, transformers, transformers-base, unordered-containers, vector, webdriver, zip-archive
Files
- .ghci +2/−0
- CHANGELOG.md +192/−0
- LICENSE +25/−0
- README.md +129/−0
- Setup.hs +2/−0
- TODO +34/−0
- src/Test/WebDriver.hs +25/−0
- src/Test/WebDriver/Capabilities.hs +703/−0
- src/Test/WebDriver/Chrome/Extension.hs +27/−0
- src/Test/WebDriver/Class.hs +74/−0
- src/Test/WebDriver/Commands.hs +795/−0
- src/Test/WebDriver/Commands/Internal.hs +95/−0
- src/Test/WebDriver/Commands/Wait.hs +129/−0
- src/Test/WebDriver/Common/Profile.hs +258/−0
- src/Test/WebDriver/Config.hs +74/−0
- src/Test/WebDriver/Exceptions.hs +11/−0
- src/Test/WebDriver/Firefox/Profile.hs +237/−0
- src/Test/WebDriver/Internal.hs +347/−0
- src/Test/WebDriver/JSON.hs +133/−0
- src/Test/WebDriver/Monad.hs +88/−0
- src/Test/WebDriver/Session.hs +115/−0
- src/Test/WebDriver/Types.hs +41/−0
- src/Test/WebDriver/Utils.hs +8/−0
- test/search-baidu.hs +39/−0
- webdriver-snoy.cabal +87/−0
+ .ghci view
@@ -0,0 +1,2 @@+:set -XOverloadedStrings+:m Test.WebDriver Data.Default
+ CHANGELOG.md view
@@ -0,0 +1,192 @@+#Change Log+##0.6+* Rather than WDSession serving dual roles as configuration and state, its functionality has been split into 2 respective types: WDConfig and WDSession.+* runSession now takes a WDConfig instead of WDSession and Capabilities parameters.+* runSession no longer closes its session on successful completion; use finallyClose or closeOnException for this behavior+* The old Test.WebDriver.Classes module has been split into Test.WebDriver.Session and Test.WebDriver.Class+* SessionState typeclass renamed to WDSessionState+* We now use the http-client package instead of HTTP. This is reflected in the addition of Manager fields in both WDConfig and WDSession++##0.5.5+* Added optional HTTP history tracking for debugging purposes.++##0.5.4+* MonadCatchIO is deprecated in favour of exceptions.+* Relaxed dependencies on mtl, network and scientific.++##0.5.3.3+* Relaxed text dependency up to 1.2++##0.5.3.2+###bug fixes+* fixed remaining compilation problems with aeson. now supports aeson >= 0.6.2.0 && < 0.8+* now depends on directory-tree instead of filesystem-trees. this fixes several problems with firefox/chrome profile support.++##0.5.3.1+###bug fixes+* fixed compilation error with aeson 0.7 and greater++##0.5.3++###new features+* SessionNotCreated constructor added to FailedCommandType+* new command deleteCookieByName added++###bug fixes+* asyncJS now properly distinguishes between a null return and a script timeout+* fixed a change in waitWhile causing the opposite of expected behavior++##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 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+* hs-webdriver now correctly handles a wider variety of server-specific responses when a webdriver command expects no return value.+* An issue with the redirect status codes used during session creation has been fixed.+* As a result of the above fixes, hs-webdriver should now work with chromedriver. Note that, prior to this version, you can still use chromedriver if you use the selenium standalone server jar as a proxy.+++##hs-webdriver 0.5+###API changes+* Test.WebDriver.Commands.Wait.unexpected now accepts a String argument, which is used as an error message+* screenshot and uploadZipEntry from Test.WebDriver.Commands now use lazy bytestrings+* wdBasePath field added to WDSession. This allows you to specify a custom base path for all WebDriver requests. The default, as specified in the WebDriver standard, is "/wd/hub"++###new features+* added Test.WebDriver.Commands.screenshotBase64++##hs-webdriver 0.4++###API changes+* finallyClose and closeOnException are now overloaded on the WebDriver class.+* NoSessionId and doSessCommand were moved from Test.WebDriver.Classes to Test.WebDriver.Commands.Internal++###bug fixes+* fixed a typo in the export list of Firefox.Profile; deleteFile is now correctly exported instead of removeFile from System.Directory +* fixed an error in the JSON representation of MouseButton++###new features+* A new module, Test.WebDriver.Commands.Internal, which exports some low-level functions used to implement the high-level interface. This makes it possible for library users to extend hs-webdriver with nonstandard or unimplemented features.++## hs-webdriver 0.3.3++###API changes+* The representation of profile files has been changed to use a HashMap instead of an association list. This ensures that destination paths are always unique.++###bug fixes+* The default preferences used by Selenium are now merged into the preferences of Firefox profiles loaded from disk.+* addExtension will now correctly add extension directories to a profile.++###known issues+* Because of the way loadProfile currently adds directories to the profileFiles HashMap, it's possible for extensions added via addExtension to be overriden by the extensions originally listed in the on-disk extensions directory.++###new features +* It's now possible to add entire directories to a profile in pure code using addFile and addExtension.+* new functions in Common.Profile: unionProfiles, onProfileFiles, onProfilePrefs+* new function in Commands.Wait: onTimeout+* the WD monad now has a MonadCatchIO instance, as an alternative to lifted-base for exception handling+++## hs-webdriver 0.3.2.1++###bug fixes+* Removed a bug in waitWhile' that resulted in an infinite loop+* Fixed the incorrect representation of JSON profiles+* Fixed relative path issues when zipping profile directories from disk++## hs-webdriver 0.3.2++###bug fixes+* Changed the constraint on filesystrem-trees to avoid a broken version+* Added the missing exports for addFile and deleteFile in Common.Profile and Firefox.Profile++###new features+* new Common.Profile functions: hasExtension, hasFile++## hs-webdriver 0.3.1 ++###API changes+* The representation of Profiles has changed, allowing it to store arbitrary files as well as extensions. The functional API for working with preferences and extensions ismostly unchanged, except for the behavior of calling addExtension consecutively with the same filepath argument.+* The old <&&> and <||> operators in Test.WebDriver.Commands.Wait have been removed and replaced with the ones exported from Control.Conditional from the cond package.++###bug fixes+* Fixed memory leak resulting from an infinite recursion in the FromJSON instance of PreparedProfile.+* loadProfile now properly loads an entire Firefox profile from disk, rather than just the extensions and preferences.++###known issues+* An issue involving lazy bytestring IO in the zip-archive package means that unusually large profiles might exceed the OSes open file limit.++###new features+* several new functions for working with Firefox/Opera profiles have been added. This includes functions for loading large profiles from disk, functions for working with zipped profiles, and functions for adding arbitrary files to a profile in pure code. +* new helper functions were added to Test.WebDriver.Commands.Wait, exported from the cond package.++## hs-webdriver 0.3.0.1++###bug fixes+* due to a nonconformance in the spec from the Grid server, wire responses were being received that contained no sessionId key, which subsequently resulted in a parse error from our JSON parser. This has been fixed, so that an omitted sessionId defaults to Nothing.+* major bux fixes in the Firefox profile code. Note that loadProfile is unlikely+to work as expected, but prepareTempProfile should.++## hs-webdriver 0.3 ++### API changes+* 2 typeclasses were introduced. All WebDriver commands are now overloaded on WebDriver class, so that monad transformers with a WD base can be used conveniently.+* The MonadState instance of WD has been removed and replaced by SessionState.+* The Firefox profile code has been generalized to work with either Opera or Firefox profiles. A phantom type parameter is used to create a distinction between the two. See documentation on Common.Profile and Firefox.Profile to learn about the specific changes that were made.+* FFLogPref is now removed and replaced by the LogPref type, because both Firefox and Opera config use the same logging preference values.+* Several new modules have been created, including: Capabilities, Monad, Classes, Exceptions. Many of the definitions have been moved around, but the export lists of the pre-existing modules are the same.++### bug fixes+* Various issues with the serialization of capabilities meant that Chrome, IE, and Opera weren't able to startup correctly with default capabilities. This is now fixed.++### new features+* General documentation improvements.+* Opera configuration is now implemented.++## hs-webdriver 0.2++### API changes+* FailedCommandInfo changed so that it stores a WDSession rather than just a Maybe SessionId, thus providing server host and port information as well as the session ID.+* As a result, mkFailedCommandInfo is now String -> WD FailedCommandInfo, since it requires access to the WDSession state.+* HTML5StorageType changed to the more accurate WebStorageType++### new features+* general documentation improvements+* the uploadFile, uploadRawFile, and uploadZipEntry functions, which support uploading file contents to the remote server++## hs-webdriver 0.1++### API changes+* getWindowSize, setWindowSize, getWindowPos, and setWindowPos have all been deprived of their WindowHandle argument. This is due to the fact that using unfocused windows with those commands causes undefined behavior. ++### new features+* the mkCookie function for convenient cookie construction+* the focusFrame function for focusing to individual frames+* the setPageLoadTimeout function+* the maximize function for maximizing windows+* support for HTML 5 web storage
+ LICENSE view
@@ -0,0 +1,25 @@+Copyright (c) 2012, Adam Curtis+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+ * Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+ * Neither the name of Adam Curtis nor the+ names of its contributors may be used to endorse or promote products+ derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,129 @@+# About+hs-webdriver is a Selenium WebDriver client for the Haskell programming language. You can use it to automate browser sessions for testing, system administration, etc.++For more information about Selenium itself, see http://seleniumhq.org/++# Installation+hs-webdriver uses the Cabal build system to configure, build, install, and generate documentation on multiple platforms.++For more information on using Cabal and its various installation options, see the Cabal User's Guide at http://www.haskell.org/cabal/users-guide/index.html++## Installation from Hackage+hs-webdriver is hosted on Hackage under the name webdriver. Thus, the simplest way to download and install the most recent version of hs-webdriver is to run:++```sh+cabal install webdriver+```+There are also options to do system-wide installation, version selection, and other build options; see cabal-install documentation.++## Installation from this repository++To build and install a git revision for a single user on your system, run these commands from within the repository directory+++### Using cabal-install++```sh+cabal install+```++### Using Cabal++For systems without cabal-install available, you can also run the Setup.hs+script, as such:++```sh+runhaskell Setup.hs configure --user+runhaskell Setup.hs build+runhaskell Setup.hs install+```++For more build options, please refer to the Cabal documentation.+++#Getting Started+WebDriver is a client-server protocol. Since hs-webdriver only implements a WebDriver client, in order to make use of this library you must have a WebDriver server that you can connect to.++##Using the Selenium stand-alone server+While you can use any WebDriver server out there, probably the simplest server to use with hs-webdriver is the Java stand-alone server. This server is cross-platform and works with every major browser. Head over to http://docs.seleniumhq.org/download/ and download the latest version of Selenium Server. Next, run the Java jar; in a POSIX shell, this should look something like:++ java -jar selenium-server-standalone-X.X.X.jar++The server should now be up and running at localhost on port 4444.++##Hello, World!+With the Selenium server running locally, you're ready to write browser automation scripts in Haskell. Let's start with a simple example.+```hs+ {-# LANGUAGE OverloadedStrings #-}+ import Test.WebDriver+ + myConfig :: WDConfig+ myConfig = defaultConfig+ + main :: IO ()+ main = runSession myConfig $ do+ openPage "http://google.com"+ searchInput <- findElem (ByCSS "input[type='text']")+ sendKeys "Hello, World!" searchInput+```+hs-webdriver uses a very simple EDSL implemented within a state monad. Interacting with the remote browser is done via a sequence of commands within this monad. The state monad maintains implicit information about the WebDriver session between commands, so that individual commands only need to specify parameters relevant to the action they perform. If you're new to monads, there are plenty of resources available for learning on the web, but for now you can think of the `WD` monad as a very simple imperative language operating on an implicitly defined session object.++Let's take a closer look at each piece of this example.++###Demonic invocations: a bit of boilerplate++ {-# LANGUAGE OverloadedStrings #-}++hs-webdriver uses the `Text` type to represent Unicode character sequences, which is significantly more efficient than the standard Haskell implementation for Unicode strings. This directive tells GHC to overload string literals so that they can be used to represent `Text` values.++ import Test.WebDriver++This line is fairly straightforward; we need to import the library so that we can use it! Most of the basic API is available through the `Test.WebDriver` module, so this is the only import you should need for most tests. There are other modules that may be of interest for advanced usage; in particular, `Test.WebDriver.Commands.Wait` provides so-called "implicit waits" as defined by other WebDriver libraries.++###Configuring a WebDriver session++ myConfig :: WDConfig+ myConfig = defaultConfig+ +To configure a new WebDriver session, we use the `WDConfig` type; this is a record type with various configuration fields. To connect to the Selenium server that we spawned earlier, the `defaultConfig` is sufficient. By default, the browser is set to Firefox, but that can be changed; the following configuration will use Google Chrome instead of Firefox for our test:++ myConfig :: WDConfig+ myConfig = defaultConfig { wdCapabilities = defaultCaps { browser = chrome } }+ +###Initializing tests++ main :: IO ()+ main = runSession myConfig $ do++`main` is the standard entry point for a Haskell program, defined as a value of type `IO a`. In order to transform our `WD` action into an `IO` action, we use the `runSession` function, which has the type:++ runSession :: WDConfig -> WD a -> IO a+ +So we pass to `runSession` our configuration record along with a WebDriver "script" to perform, and it transforms the script into a side-effectful `IO` action. The `WDConfig` record is used to automatically initialize our session with the remote server.++NOTE: `runSession` does not automatically close the session it creates. This is intentional, as you may want to manually inspect the browser state after your code executes. If you want to have the session automatically close, you can use the `finallyClose` function to provide this behavior.++ main = runSession myConfig . finallyClose $ do+++###Actually writing tests!++ openPage "http://google.com"+ searchInput <- findElem (ByCSS "input[type='text']")+ sendKeys "Hello, World!" searchInput++Interaction with the browser is accomplished via WebDriver "commands", which are just function calls within the `WD` monad. Most of these commands are defined in the `Test.WebDriver.Commands` modules, and are fairly self-explanatory. In this example, `openPage` opens a new URL, and `findElem` searches for a DOM element on the current page which matches the given selector (possible selectors include `ById`, `ByName`, `ByClass`, `ByTag`, `ByLinkText`, `ByCSS`, and `ByXPath`). The DOM Element found by the result of the search is bound to the local variable `searchInput`, and `sendKeys` sends a sequence of emulated keystrokes to the given element.++This example contains all of the basic elements of a simple WebDriver test. For complete documentation on each command, check out the documentation for `Test.WebDriver.Commands` (see [#Documentation](Documentation)).+++#Documentation++Documentation for hs-webdriver is available on Hackage at <http://hackage.haskell.org/package/webdriver>. However, here's how to generate local HTML documentation from this source revision:++```sh+runhaskell Setup.hs haddock+```++Haddock will generate documentation and save it in dist/doc/html/webdriver+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ TODO view
@@ -0,0 +1,34 @@+in upcoming releases++-- fix loadProfile so that it doesn't cause an overlap with user addExtension calls++-- add support for Opera profiles++-- improve documentation+ -- document errors.+ -- provide examples+ -- basic runSession usage+ -- intermediate usage+ -- exception handling with lifted-base+ -- explicit waits usage+ -- firefox profile usage+ -- REPL usage+++for 1.0++-- add WDSettings, use WDSession as internal State type. +-- allow settings to automatically load drivers. add modules with driver loading+functions+-- use http-conduit and attoparsec-conduit to stream JSON data. use request methods from http-types++++distant future++-- use ReaderT to store WDVersion for use with implicit configurations.+++misc. unsorted++--consider adding withSession to SessionState so that it can be overloaded easily, or rewriting it so that it's overloaded but not a method itself.
+ src/Test/WebDriver.hs view
@@ -0,0 +1,25 @@+{-|+This module serves as the top-level interface to the Haskell WebDriver bindings,+providing most of the functionality you're likely to want.+-}+module Test.WebDriver+ ( -- * WebDriver sessions+ WD(..), WDConfig(..), defaultConfig+ -- * Running WebDriver tests+ , runWD, runSession, withSession, finallyClose, closeOnException, dumpSessionHistory+ -- * WebDriver commands+ , module Test.WebDriver.Commands+ -- * Capabilities and configuration+ , Capabilities(..), defaultCaps, allCaps+ , Platform(..), ProxyType(..)+ -- ** Browser-specific configuration+ , Browser(..), LogLevel(..)+ , firefox, chrome, ie, opera, iPhone, iPad, android+ -- * Exceptions+ , module Test.WebDriver.Exceptions+ ) where++import Test.WebDriver.Types+import Test.WebDriver.Commands+import Test.WebDriver.Monad+import Test.WebDriver.Exceptions
+ src/Test/WebDriver/Capabilities.hs view
@@ -0,0 +1,703 @@+{-# LANGUAGE OverloadedStrings, RecordWildCards+ #-}+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)++{- |A structure describing the capabilities of a session. This record+serves dual roles.++* It's used to specify the desired capabilities for a session before+it's created. In this usage, fields that are set to Nothing indicate+that we have no preference for that capability.++* When received from the server , it's used to+describe the actual capabilities given to us by the WebDriver+server. Here a value of Nothing indicates that the server doesn't+support the capability. Thus, for Maybe Bool fields, both Nothing and+Just False indicate a lack of support for the desired capability.+-}+data Capabilities =+ Capabilities { -- |Browser choice and browser specific settings.+ browser :: Browser+ -- |Browser version to use.+ , version :: Maybe String+ -- |Platform on which the browser should run.+ , platform :: Platform+ -- |Proxy configuration settings.+ , proxy :: ProxyType+ -- |Whether the session supports executing JavaScript via+ -- 'executeJS' and 'asyncJS'.+ , javascriptEnabled :: Maybe Bool+ -- |Whether the session supports taking screenshots of the+ -- current page with the 'screenshot' command+ , takesScreenshot :: Maybe Bool+ -- |Whether the session can interact with modal popups,+ -- such as window.alert and window.confirm via+ -- 'acceptAlerts', 'dismissAlerts', etc.+ , handlesAlerts :: Maybe Bool+ -- |Whether the session can interact with database storage.+ , databaseEnabled :: Maybe Bool+ -- |Whether the session can set and query the browser's+ -- location context with 'setLocation' and 'getLocation'.+ , locationContextEnabled :: Maybe Bool+ -- |Whether the session can interact with the application cache+ -- .+ , applicationCacheEnabled :: Maybe Bool+ -- |Whether the session can query for the browser's+ -- connectivity and disable it if desired+ , browserConnectionEnabled :: Maybe Bool+ -- |Whether the session supports CSS selectors when searching+ -- for elements.+ , cssSelectorsEnabled :: Maybe Bool+ -- |Whether Web Storage ('getKey', 'setKey', etc) support is+ -- enabled+ , webStorageEnabled :: Maybe Bool+ -- |Whether the session can rotate the current page's current+ -- layout between 'Portrait' and 'Landscape' orientations.+ , rotatable :: Maybe Bool+ -- |Whether the session should accept all SSL certs by default+ , acceptSSLCerts :: Maybe Bool+ -- |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+ 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 = []+ }++-- |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' capabilities are set to 'Nothing' (no preference).+defaultCaps :: Capabilities+defaultCaps = def++-- |Same as 'defaultCaps', but with all 'Maybe' 'Bool' capabilities set to+-- 'Just' 'True'.+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 --backwards compatability+ ,"opera.autostart" .= operaAutoStart+ , "opera.idle" .= operaIdle+ -- ,"opera.profile" .= operaProfile+ ,"opera.port" .= fromMaybe (-1) operaPort+ --note: consider replacing operaOptions with a list of options+ ,"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 --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+-- use, while also providing browser-specific configuration. Default+-- configuration is provided for each browser by 'firefox', 'chrome', 'opera',+-- 'ie', etc.+--+-- This library uses 'firefox' as its 'Default' browser configuration, when no+-- browser choice is specified.+data Browser = Firefox { -- |The firefox profile to use. If Nothing,+ -- a default temporary profile is automatically created+ -- and used.+ ffProfile :: Maybe (PreparedProfile Firefox)+ -- |Firefox logging preference+ , ffLogPref :: LogLevel+ -- |Server-side path to Firefox binary. If Nothing,+ -- use a sensible system-based default.+ , ffBinary :: Maybe FilePath+ }+ | Chrome { -- |Version of the Chrome Webdriver server server to use+ --+ -- for more information on chromedriver see+ -- <http://code.google.com/p/selenium/wiki/ChromeDriver>+ chromeDriverVersion :: Maybe String+ -- |Server-side path to Chrome binary. If Nothing,+ -- use a sensible system-based default.+ , chromeBinary :: Maybe FilePath+ -- |A list of command-line options to pass to the+ -- Chrome binary.+ , chromeOptions :: [String]+ -- |A list of extensions to use.+ , chromeExtensions :: [ChromeExtension]+ }+ | IE { -- |Whether to skip the protected mode check. If set, tests+ -- may become flaky, unresponsive, or browsers may hang. If+ -- not set, and protected mode settings are not the same for+ -- all zones, an exception will be thrown on driver+ -- construction.+ 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+ --, operaNoRestart :: Maybe Bool+ -- |Which Opera product we're using, e.g. \"desktop\",+ -- \"core\"+ , operaProduct :: Maybe String+ -- |Whether the Opera instance should stay open after+ -- we close the session. If false, closing the session+ -- closes the browser.+ , operaDetach :: Bool+ -- |Whether to auto-start the Opera binary. If false,+ -- OperaDriver will wait for a connection from the+ -- browser. By default this is True.+ , operaAutoStart :: Bool+ -- |Whether to use Opera's alternative implicit wait+ -- implementation. It will use an in-browser heuristic+ -- to guess when a page has finished loading. This+ -- feature is experimental, and disabled by default.+ , operaIdle :: Bool+ -- |(*nix only) which X display to use.+ , operaDisplay :: Maybe Int+ --, operaProfile :: Maybe (PreparedProfile Opera)+ -- |Path to the launcher binary to use. The launcher+ -- is a gateway between OperaDriver and the Opera+ -- browser. If Nothing, OperaDriver will use the+ -- launcher supplied with the package.+ , operaLauncher :: Maybe FilePath+ -- |The port we should use to connect to Opera. If Just 0+ -- , use a random port. If Nothing, use the default+ -- Opera port. The default 'opera' constructor uses+ -- Just 0, since Nothing is likely to cause "address+ -- already in use" errors.+ , operaPort :: Maybe Word16+ -- |The host Opera should connect to. Unless you're+ -- starting Opera manually you won't need this.+ , operaHost :: Maybe String+ -- |Command-line arguments to pass to Opera.+ , operaOptions :: Maybe String+ -- |Where to send the log output. If Nothing, logging is+ -- disabled.+ , operaLogFile :: Maybe FilePath+ -- |Log level preference. Defaults to 'LogInfo'+ , operaLogPref :: LogLevel+ }+ | HTMLUnit+ | IPhone+ | IPad+ | Android+ -- |some other browser, specified by a string name+ | 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+ -- "safari" -> return safari+ "iphone" -> return iPhone+ "ipad" -> return iPad+ "android" -> return android+ "htmlunit" -> return htmlUnit+ other -> return (Browser other)+ parseJSON v = typeMismatch "Browser" v+++-- |Default Firefox settings. All Maybe fields are set to Nothing. ffLogPref+-- is set to 'LogInfo'.+firefox :: Browser+firefox = Firefox Nothing def Nothing++-- |Default Chrome settings. All Maybe fields are set to Nothing, no options are+-- specified, and no extensions are used.+chrome :: Browser+chrome = Chrome Nothing Nothing [] []++-- |Default IE settings. See the 'IE' constructor for more details on+-- individual defaults+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+ }++-- |Default Opera settings. See the 'Opera' constructor for more details on+-- individual defaults.+opera :: Browser+opera = Opera { operaBinary = Nothing+ --, operaNoRestart = Nothing+ , operaProduct = Nothing+ , operaDetach = False+ , operaAutoStart = True+ , operaDisplay = Nothing+ , operaIdle = False+-- , operaProfile = Nothing+ , operaLauncher = Nothing+ , operaHost = Nothing+ , operaPort = Just 0+ , operaOptions = Nothing+ , operaLogFile = Nothing+ , operaLogPref = def+ }++--safari :: Browser+--safari = Safari++htmlUnit :: Browser+htmlUnit = HTMLUnit++iPhone :: Browser+iPhone = IPhone++iPad :: Browser+iPad = IPad++android :: Browser+android = Android++-- |Represents platform options supported by WebDriver. The value Any represents+-- no preference.+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++-- |Available settings for the proxy 'Capabilities' field+data ProxyType = NoProxy+ | UseSystemSettings+ | AutoDetect+ -- |Use a proxy auto-config file specified by URL+ | PAC { autoConfigUrl :: String }+ -- |Manually specify proxy hosts as hostname:port strings.+ -- Note that behavior is undefined for empty strings.+ | 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++-- |Indicates a log verbosity level. Used in 'Firefox' and 'Opera' configuration.+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+++-- |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/Chrome/Extension.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleContexts #-}+-- |Functions and types for working with Google Chrome extensions.+module Test.WebDriver.Chrome.Extension+ ( ChromeExtension+ , loadExtension+ , loadRawExtension+ ) where+import Data.ByteString.Lazy as LBS+import Data.ByteString.Base64.Lazy as B64+import Data.Text.Lazy+import Data.Text.Lazy.Encoding (decodeLatin1)+import Data.Aeson+import Control.Applicative+import Control.Monad.Base++-- |An opaque type representing a Google Chrome extension. Values of this type+-- are passed to the 'Test.Webdriver.chromeExtensions' field.+newtype ChromeExtension = ChromeExtension Text+ deriving (Eq, Show, Read, ToJSON, FromJSON)++-- |Load a .crx file as a 'ChromeExtension'.+loadExtension :: MonadBase IO m => FilePath -> m ChromeExtension+loadExtension path = liftBase $ loadRawExtension <$> LBS.readFile path++-- |Load raw .crx data as a 'ChromeExtension'.+loadRawExtension :: ByteString -> ChromeExtension+loadRawExtension = ChromeExtension . decodeLatin1 . B64.encode
+ src/Test/WebDriver/Class.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, FlexibleContexts,+ GeneralizedNewtypeDeriving, RecordWildCards #-}+module Test.WebDriver.Class+ ( -- * WebDriver class+ WebDriver(..), Method, methodDelete, methodGet, methodPost,+ ) where+import Test.WebDriver.Session ++import Data.Aeson+import Data.Text (Text)++import Network.HTTP.Types.Method (methodDelete, methodGet, methodPost, Method)++import Control.Monad.Trans.Maybe+import Control.Monad.Trans.Identity+import Control.Monad.List+import Control.Monad.Reader+import Control.Monad.Error+--import Control.Monad.Cont+import Control.Monad.Writer.Strict as SW+import Control.Monad.Writer.Lazy as LW+import Control.Monad.State.Strict as SS+import Control.Monad.State.Lazy as LS+import Control.Monad.RWS.Strict as SRWS+import Control.Monad.RWS.Lazy as LRWS++++ +-- |A class for monads that can handle wire protocol requests. This is the+-- operation underlying all of the high-level commands exported in+-- "Test.WebDriver.Commands". For more information on the wire protocol see+-- <http://code.google.com/p/selenium/wiki/JsonWireProtocol>+class (WDSessionState wd) => WebDriver wd where+ doCommand :: (ToJSON a, FromJSON b) =>+ Method -- ^HTTP request method+ -> Text -- ^URL of request+ -> a -- ^JSON parameters passed in the body+ -- of the request. Note that, as a special case,+ -- anything that converts to Data.Aeson.Null will+ -- result in an empty request body.+ -> wd b -- ^The JSON result of the HTTP request.++instance WebDriver wd => WebDriver (SS.StateT s wd) where+ doCommand rm t a = lift (doCommand rm t a)+ +instance WebDriver wd => WebDriver (LS.StateT s wd) where+ doCommand rm t a = lift (doCommand rm t a)+++instance WebDriver wd => WebDriver (MaybeT wd) where+ doCommand rm t a = lift (doCommand rm t a)+++instance WebDriver wd => WebDriver (IdentityT wd) where+ doCommand rm t a = lift (doCommand rm t a)+++instance (Monoid w, WebDriver wd) => WebDriver (LW.WriterT w wd) where+ doCommand rm t a = lift (doCommand rm t a)+++instance WebDriver wd => WebDriver (ReaderT r wd) where+ doCommand rm t a = lift (doCommand rm t a)++instance (Error e, WebDriver wd) => WebDriver (ErrorT e wd) where+ doCommand rm t a = lift (doCommand rm t a)+++instance (Monoid w, WebDriver wd) => WebDriver (SRWS.RWST r w s wd) where+ doCommand rm t a = lift (doCommand rm t a)++instance (Monoid w, WebDriver wd) => WebDriver (LRWS.RWST r w s wd) where+ doCommand rm t a = lift (doCommand rm t a)
+ src/Test/WebDriver/Commands.hs view
@@ -0,0 +1,795 @@+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, ExistentialQuantification,+ TemplateHaskell, RecordWildCards #-}+-- |This module exports basic WD actions that can be used to interact with a+-- browser session.+module Test.WebDriver.Commands+ ( -- * Sessions+ createSession, closeSession, sessions, getCaps+ -- * Browser interaction+ -- ** Web navigation+ , openPage, forward, back, refresh+ -- ** Page info+ , getCurrentURL, getSource, getTitle, screenshot, screenshotBase64+ -- * Timeouts+ , setImplicitWait, setScriptTimeout, setPageLoadTimeout+ -- * Web elements+ , Element(..), Selector(..)+ -- ** Searching for elements+ , findElem, findElems, findElemFrom, findElemsFrom+ -- ** Interacting with elements+ , click, submit, getText+ -- *** Sending key inputs to elements+ , sendKeys, sendRawKeys, clearInput+ -- ** Element information+ , attr, cssProp, elemPos, elemSize+ , isSelected, isEnabled, isDisplayed+ , tagName, activeElem, elemInfo+ -- ** Element equality+ , (<==>), (</=>)+ -- * Javascript+ , executeJS, asyncJS+ , JSArg(..)+ -- * Windows+ , WindowHandle(..), currentWindow+ , getCurrentWindow, closeWindow, windows, focusWindow, maximize+ , getWindowSize, setWindowSize, getWindowPos, setWindowPos+ -- * Focusing on frames+ , focusFrame, FrameSelector(..)+ -- * Cookies+ , Cookie(..), mkCookie+ , cookies, setCookie, deleteCookie, deleteVisibleCookies, deleteCookieByName+ -- * Alerts+ , getAlertText, replyToAlert, acceptAlert, dismissAlert+ -- * Mouse gestures+ , moveTo, moveToCenter, moveToFrom+ , clickWith, MouseButton(..)+ , mouseDown, mouseUp, withMouseDown, doubleClick+ -- * HTML 5 Web Storage+ , WebStorageType(..), storageSize, getAllKeys, deleteAllKeys+ , getKey, setKey, deleteKey+ -- * HTML 5 Application Cache+ , ApplicationCacheStatus(..)+ , getApplicationCacheStatus+ -- * Mobile device support+ -- ** Screen orientation+ , Orientation(..)+ , getOrientation, setOrientation+ -- ** Geo-location+ , getLocation, setLocation+ -- ** Touch gestures+ , touchClick, touchDown, touchUp, touchMove+ , touchScroll, touchScrollFrom, touchDoubleClick+ , touchLongClick, touchFlick, touchFlickFrom+ -- * IME support+ , availableIMEEngines, activeIMEEngine, checkIMEActive+ , activateIME, deactivateIME+ -- * Uploading files to remote server+ -- |These functions allow you to upload a file to a remote server.+ -- Note that this operation isn't supported by all WebDriver servers,+ -- and the location where the file is stored is not standardized.+ , uploadFile, uploadRawFile, uploadZipEntry+ -- * Server information and logs+ , serverStatus+ , getLogs, getLogTypes, LogType, LogEntry(..), LogLevel(..)+ ) where++import Test.WebDriver.Commands.Internal+import Test.WebDriver.Class+import Test.WebDriver.Session+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, append, toUpper, toLower)+import Data.ByteString.Base64.Lazy as B64+import Data.ByteString.Lazy as LBS (ByteString)+import Network.URI hiding (path) -- suppresses warnings+import Codec.Archive.Zip+import qualified Data.Text.Lazy.Encoding as TL++import Control.Applicative+import Control.Monad.State.Strict+import Control.Monad.Base+import Control.Exception (SomeException)+import Control.Exception.Lifted (throwIO, handle)+import qualified Control.Exception.Lifted as L+import Data.Word+import Data.String (fromString)+import Data.Maybe+import qualified Data.Char as C++-- |Convenience function to handle webdriver commands with no return value+noReturn :: WebDriver wd => wd NoReturn -> wd ()+noReturn = void++-- |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+ ignoreReturn . doCommand methodPost "/session" . single "desiredCapabilities" $ caps+ getSession++-- |Retrieve a list of active sessions and their 'Capabilities'.+sessions :: WebDriver wd => wd [(SessionId, Capabilities)]+sessions = do+ objs <- doCommand methodGet "/sessions" Null+ forM objs $ parsePair "id" "capabilities" "sessions"++-- |Get the actual 'Capabilities' of the current session.+getCaps :: WebDriver wd => wd Capabilities+getCaps = doSessCommand methodGet "" Null++-- |Close the current session and the browser associated with it.+closeSession :: WebDriver wd => wd ()+closeSession = do s@WDSession {..} <- getSession+ noReturn $ doSessCommand methodDelete "" Null+ putSession s { wdSessId = Nothing }+++-- |Sets the amount of time we implicitly wait when searching for elements.+setImplicitWait :: WebDriver wd => Integer -> wd ()+setImplicitWait ms =+ noReturn $ doSessCommand methodPost "/timeouts/implicit_wait" (object msField)+ `L.catch` \(_ :: SomeException) ->+ doSessCommand methodPost "/timeouts" (object allFields)+ where msField = ["ms" .= ms]+ allFields = ["type" .= ("implicit" :: String)] ++ msField++-- |Sets the amount of time we wait for an asynchronous script to return a+-- result.+setScriptTimeout :: WebDriver wd => Integer -> wd ()+setScriptTimeout ms =+ noReturn $ doSessCommand methodPost "/timeouts/async_script" (object msField)+ `L.catch` \( _ :: SomeException) ->+ doSessCommand methodPost "/timeouts" (object allFields)+ where msField = ["ms" .= ms]+ allFields = ["type" .= ("script" :: String)] ++ msField++-- |Sets the amount of time to wait for a page to finish loading before throwing a 'Timeout' exception+setPageLoadTimeout :: WebDriver wd => Integer -> wd ()+setPageLoadTimeout ms = noReturn $ doSessCommand methodPost "/timeouts" params+ where params = object ["type" .= ("page load" :: String)+ ,"ms" .= ms ]++-- |Gets the URL of the current page.+getCurrentURL :: WebDriver wd => wd String+getCurrentURL = doSessCommand methodGet "/url" Null++-- |Opens a new page by the given URL.+openPage :: WebDriver wd => String -> wd ()+openPage url+ | isURI url = noReturn . doSessCommand methodPost "/url" . single "url" $ url+ | otherwise = throwIO . InvalidURL $ url++-- |Navigate forward in the browser history.+forward :: WebDriver wd => wd ()+forward = noReturn $ doSessCommand methodPost "/forward" Null++-- |Navigate backward in the browser history.+back :: WebDriver wd => wd ()+back = noReturn $ doSessCommand methodPost "/back" Null++-- |Refresh the current page+refresh :: WebDriver wd => wd ()+refresh = noReturn $ doSessCommand methodPost "/refresh" Null++-- |An existential wrapper for any 'ToJSON' instance. This allows us to pass+-- parameters of many different types to Javascript code.+data JSArg = forall a. ToJSON a => JSArg a++instance ToJSON JSArg where+ toJSON (JSArg a) = toJSON a++{- |Inject a snippet of Javascript into the page for execution in the+context of the currently selected frame. The executed script is+assumed to be synchronous and the result of evaluating the script is+returned and converted to an instance of FromJSON.++The first parameter defines arguments to pass to the javascript+function. Arguments of type Element will be converted to the+corresponding DOM element. Likewise, any elements in the script result+will be returned to the client as Elements.++The second parameter defines the script itself in the form of a+function body. The value returned by that function will be returned to+the client. The function will be invoked with the provided argument+list and the values may be accessed via the arguments object in the+order specified.+-}+executeJS :: (WebDriver wd, FromJSON a) => [JSArg] -> Text -> wd a+executeJS a s = fromJSON' =<< getResult+ where+ getResult = doSessCommand methodPost "/execute" . pair ("args", "script") $ (a,s)++{- |Executes a snippet of Javascript code asynchronously. This function works+similarly to 'executeJS', except that the Javascript is passed a callback+function as its final argument. The script should call this function+to signal that it has finished executing, passing to it a value that will be+returned as the result of asyncJS. A result of Nothing indicates that the+Javascript function timed out (see 'setScriptTimeout')+-}+asyncJS :: (WebDriver wd, FromJSON a) => [JSArg] -> Text -> wd (Maybe a)+asyncJS a s = handle timeout $ Just <$> (fromJSON' =<< getResult)+ where+ getResult = doSessCommand methodPost "/execute_async" . pair ("args", "script")+ $ (a,s)+ timeout (FailedCommand Timeout _) = return Nothing+ timeout (FailedCommand ScriptTimeout _) = return Nothing+ timeout err = throwIO err++-- |Grab a screenshot of the current page as a PNG image+screenshot :: WebDriver wd => wd LBS.ByteString+screenshot = B64.decodeLenient <$> screenshotBase64++-- |Grab a screenshot as a base-64 encoded PNG image. This is the protocol-defined format.+screenshotBase64 :: WebDriver wd => wd LBS.ByteString+screenshotBase64 = TL.encodeUtf8 <$> doSessCommand methodGet "/screenshot" Null++availableIMEEngines :: WebDriver wd => wd [Text]+availableIMEEngines = doSessCommand methodGet "/ime/available_engines" Null++activeIMEEngine :: WebDriver wd => wd Text+activeIMEEngine = doSessCommand methodGet "/ime/active_engine" Null++checkIMEActive :: WebDriver wd => wd Bool+checkIMEActive = doSessCommand methodGet "/ime/activated" Null++activateIME :: WebDriver wd => Text -> wd ()+activateIME = noReturn . doSessCommand methodPost "/ime/activate" . single "engine"++deactivateIME :: WebDriver wd => wd ()+deactivateIME = noReturn $ doSessCommand methodPost "/ime/deactivate" Null+++-- |Specifies the frame used by 'Test.WebDriver.Commands.focusFrame'+data FrameSelector = WithIndex Integer+ -- |focus on a frame by name or ID+ | WithName Text+ -- |focus on a frame 'Element'+ | WithElement Element+ -- |focus on the first frame, or the main document+ -- if iframes are used.+ | DefaultFrame+ deriving (Eq, Show, Read)++instance ToJSON FrameSelector where+ toJSON s = case s of+ WithIndex i -> toJSON i+ WithName n -> toJSON n+ WithElement e -> toJSON e+ DefaultFrame -> Null++-- |Switch focus to the frame specified by the FrameSelector.+focusFrame :: WebDriver wd => FrameSelector -> wd ()+focusFrame s = noReturn $ doSessCommand methodPost "/frame" . single "id" $ s++-- |Returns a handle to the currently focused window+getCurrentWindow :: WebDriver wd => wd WindowHandle+getCurrentWindow = doSessCommand methodGet "/window_handle" Null++-- |Returns a list of all windows available to the session+windows :: WebDriver wd => wd [WindowHandle]+windows = doSessCommand methodGet "/window_handles" Null++focusWindow :: WebDriver wd => WindowHandle -> wd ()+focusWindow w = noReturn $ doSessCommand methodPost "/window" . single "name" $ w++-- |Closes the given window+closeWindow :: WebDriver wd => WindowHandle -> wd ()+closeWindow = noReturn . doSessCommand methodDelete "/window" . single "name"++-- |Maximizes the current window if not already maximized+maximize :: WebDriver wd => wd ()+maximize = noReturn $ doWinCommand methodGet currentWindow "/maximize" Null++-- |Get the dimensions of the current window.+getWindowSize :: WebDriver wd => wd (Word, Word)+getWindowSize = doWinCommand methodGet currentWindow "/size" Null+ >>= parsePair "width" "height" "getWindowSize"++-- |Set the dimensions of the current window.+setWindowSize :: WebDriver wd => (Word, Word) -> wd ()+setWindowSize = noReturn . doWinCommand methodPost currentWindow "/size"+ . pair ("width", "height")++-- |Get the coordinates of the current window.+getWindowPos :: WebDriver wd => wd (Int, Int)+getWindowPos = doWinCommand methodGet currentWindow "/position" Null+ >>= parsePair "x" "y" "getWindowPos"++-- |Set the coordinates of the current window.+setWindowPos :: WebDriver wd => (Int, Int) -> wd ()+setWindowPos = noReturn . doWinCommand methodPost currentWindow "/position" . pair ("x","y")++-- |Cookies are delicious delicacies. When sending cookies to the server, a value+-- of Nothing indicates that the server should use a default value. When receiving+-- cookies from the server, a value of Nothing indicates that the server is unable+-- to specify the value.+data Cookie = Cookie { cookName :: Text+ , cookValue :: Text -- ^+ , cookPath :: Maybe Text -- ^path of this cookie.+ -- if Nothing, defaults to /+ , cookDomain :: Maybe Text -- ^domain of this cookie.+ -- if Nothing, the current pages+ -- domain is used+ , cookSecure :: Maybe Bool -- ^Is this cookie secure?+ , cookExpiry :: Maybe Integer -- ^Expiry date expressed as+ -- seconds since the Unix epoch+ -- Nothing indicates that the+ -- cookie never expires+ } deriving (Eq, Show)++-- |Creates a Cookie with only a name and value specified. All other+-- fields are set to Nothing, which tells the server to use default values.+mkCookie :: Text -> Text -> Cookie+mkCookie name value = Cookie { cookName = name, cookValue = value,+ cookPath = Nothing, cookDomain = Nothing,+ cookSecure = Nothing, cookExpiry = Nothing+ }++-- This line causes a strange out of scope error. Moving to the bottom of the+-- file fixed it.+-- $( deriveToJSON (map C.toLower . drop 4) ''Cookie )++instance FromJSON Cookie where+ parseJSON (Object o) = Cookie <$> req "name"+ <*> req "value"+ <*> opt "path" Nothing+ <*> opt "domain" Nothing+ <*> opt "secure" Nothing+ <*> opt "expiry" Nothing+ where+ req :: FromJSON a => Text -> Parser a+ req = (o .:)+ opt :: FromJSON a => Text -> a -> Parser a+ opt k d = o .:? k .!= d+ parseJSON v = typeMismatch "Cookie" v++-- |Retrieve all cookies visible to the current page.+cookies :: WebDriver wd => wd [Cookie]+cookies = doSessCommand methodGet "/cookie" Null++-- |Set a cookie. If the cookie path is not specified, it will default to \"/\".+-- Likewise, if the domain is omitted, it will default to the current page's+-- domain+setCookie :: WebDriver wd => Cookie -> wd ()+setCookie = noReturn . doSessCommand methodPost "/cookie" . single "cookie"++-- |Delete a cookie. This will do nothing is the cookie isn't visible to the+-- current page.+deleteCookie :: WebDriver wd => Cookie -> wd ()+deleteCookie c = noReturn $ doSessCommand methodDelete ("/cookie/" `append` urlEncode (cookName c)) Null++deleteCookieByName :: WebDriver wd => Text -> wd ()+deleteCookieByName n = noReturn $ doSessCommand methodDelete ("/cookie/" `append` n) Null++-- |Delete all visible cookies on the current page.+deleteVisibleCookies :: WebDriver wd => wd ()+deleteVisibleCookies = noReturn $ doSessCommand methodDelete "/cookie" Null++-- |Get the current page source+getSource :: WebDriver wd => wd Text+getSource = doSessCommand methodGet "/source" Null++-- |Get the title of the current page.+getTitle :: WebDriver wd => wd Text+getTitle = doSessCommand methodGet "/title" Null++-- |Specifies element(s) within a DOM tree using various selection methods.+data Selector = ById Text+ | ByName Text+ | ByClass Text -- ^ (Note: multiple classes are not+ -- allowed. For more control, use 'ByCSS')+ | ByTag Text+ | ByLinkText Text+ | ByPartialLinkText Text+ | ByCSS Text+ | ByXPath Text+ deriving (Eq, Show, Ord)++instance ToJSON Selector where+ toJSON s = case s of+ ById t -> selector "id" t+ ByName t -> selector "name" t+ ByClass t -> selector "class name" t+ ByTag t -> selector "tag name" t+ ByLinkText t -> selector "link text" t+ ByPartialLinkText t -> selector "partial link text" t+ ByCSS t -> selector "css selector" t+ ByXPath t -> selector "xpath" t+ where+ selector :: Text -> Text -> Value+ selector sn t = object ["using" .= sn, "value" .= t]++-- |Find an element on the page using the given element selector.+findElem :: WebDriver wd => Selector -> wd Element+findElem = doSessCommand methodPost "/element"++-- |Find all elements on the page matching the given selector.+findElems :: WebDriver wd => Selector -> wd [Element]+findElems = doSessCommand methodPost "/elements"++-- |Return the element that currently has focus.+activeElem :: WebDriver wd => wd Element+activeElem = doSessCommand methodPost "/element/active" Null++-- |Search for an element using the given element as root.+findElemFrom :: WebDriver wd => Element -> Selector -> wd Element+findElemFrom e = doElemCommand methodPost e "/element"++-- |Find all elements matching a selector, using the given element as root.+findElemsFrom :: WebDriver wd => Element -> Selector -> wd [Element]+findElemsFrom e = doElemCommand methodPost e "/elements"++-- |Describe the element. Returns a JSON object whose meaning is currently+-- undefined by the WebDriver protocol.+elemInfo :: WebDriver wd => Element -> wd Value+elemInfo e = doElemCommand methodGet e "" Null++-- |Click on an element.+click :: WebDriver wd => Element -> wd ()+click e = noReturn $ doElemCommand methodPost e "/click" Null++-- |Submit a form element. This may be applied to descendents of a form element+-- as well.+submit :: WebDriver wd => Element -> wd ()+submit e = noReturn $ doElemCommand methodPost e "/submit" Null++-- |Get all visible text within this element.+getText :: WebDriver wd => Element -> wd Text+getText e = doElemCommand methodGet e "/text" Null++-- |Send a sequence of keystrokes to an element. All modifier keys are released+-- at the end of the function. For more information about modifier keys, see+-- <http://code.google.com/p/selenium/wiki/JsonWireProtocol#/session/:sessionId/element/:id/value>+sendKeys :: WebDriver wd => Text -> Element -> wd ()+sendKeys t e = noReturn . doElemCommand methodPost e "/value" . single "value" $ [t]++-- |Similar to sendKeys, but doesn't implicitly release modifier keys+-- afterwards. This allows you to combine modifiers with mouse clicks.+sendRawKeys :: WebDriver wd => Text -> Element -> wd ()+sendRawKeys t e = noReturn . doElemCommand methodPost e "/keys" . single "value" $ [t]++-- |Return the tag name of the given element.+tagName :: WebDriver wd => Element -> wd Text+tagName e = doElemCommand methodGet e "/name" Null++-- |Clear a textarea or text input element's value.+clearInput :: WebDriver wd => Element -> wd ()+clearInput e = noReturn $ doElemCommand methodPost e "/clear" Null++-- |Determine if the element is selected.+isSelected :: WebDriver wd => Element -> wd Bool+isSelected e = doElemCommand methodGet e "/selected" Null++-- |Determine if the element is enabled.+isEnabled :: WebDriver wd => Element -> wd Bool+isEnabled e = doElemCommand methodGet e "/enabled" Null++-- |Determine if the element is displayed.+isDisplayed :: WebDriver wd => Element -> wd Bool+isDisplayed e = doElemCommand methodGet e "/displayed" Null++-- |Retrieve the value of an element's attribute+attr :: WebDriver wd => Element -> Text -> wd (Maybe Text)+attr e t = doElemCommand methodGet 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 methodGet e ("/css/" `append` urlEncode t) Null++-- |Retrieve an element's current position.+elemPos :: WebDriver wd => Element -> wd (Int, Int)+elemPos e = doElemCommand methodGet e "/location" Null >>= parsePair "x" "y" "elemPos"++-- |Retrieve an element's current size.+elemSize :: WebDriver wd => Element -> wd (Word, Word)+elemSize e = doElemCommand methodGet e "/size" Null+ >>= parsePair "width" "height" "elemSize"++infix 4 <==>+-- |Determines if two element identifiers refer to the same element.+(<==>) :: WebDriver wd => Element -> Element -> wd Bool+e1 <==> (Element e2) = doElemCommand methodGet e1 ("/equals/" `append` urlEncode e2) Null++-- |Determines if two element identifiers refer to different elements.+infix 4 </=>+(</=>) :: WebDriver wd => Element -> Element -> wd Bool+e1 </=> e2 = not <$> (e1 <==> e2)++-- |A screen orientation+data Orientation = Landscape | Portrait+ deriving (Eq, Show, Ord, Bounded, Enum)++instance ToJSON Orientation where+ toJSON = String . toUpper . fromString . show++instance FromJSON Orientation where+ parseJSON (String jStr) = case toLower jStr of+ "landscape" -> return Landscape+ "portrait" -> return Portrait+ err -> fail $ "Invalid Orientation string " ++ show err+ parseJSON v = typeMismatch "Orientation" v++-- |Get the current screen orientation for rotatable display devices.+getOrientation :: WebDriver wd => wd Orientation+getOrientation = doSessCommand methodGet "/orientation" Null++-- |Set the current screen orientation for rotatable display devices.+setOrientation :: WebDriver wd => Orientation -> wd ()+setOrientation = noReturn . doSessCommand methodPost "/orientation" . single "orientation"++-- |Get the text of an alert dialog.+getAlertText :: WebDriver wd => wd Text+getAlertText = doSessCommand methodGet "/alert_text" Null++-- |Sends keystrokes to Javascript prompt() dialog.+replyToAlert :: WebDriver wd => Text -> wd ()+replyToAlert = noReturn . doSessCommand methodPost "/alert_text" . single "text"++-- |Accepts the currently displayed alert dialog.+acceptAlert :: WebDriver wd => wd ()+acceptAlert = noReturn $ doSessCommand methodPost "/accept_alert" Null++-- |Dismisses the currently displayed alert dialog.+dismissAlert :: WebDriver wd => wd ()+dismissAlert = noReturn $ doSessCommand methodPost "/dismiss_alert" Null++-- |Moves the mouse to the given position relative to the active element.+moveTo :: WebDriver wd => (Int, Int) -> wd ()+moveTo = noReturn . doSessCommand methodPost "/moveto" . pair ("xoffset","yoffset")++-- |Moves the mouse to the center of a given element.+moveToCenter :: WebDriver wd => Element -> wd ()+moveToCenter (Element e) =+ noReturn . doSessCommand methodPost "/moveto" . single "element" $ e++-- |Moves the mouse to the given position relative to the given element.+moveToFrom :: WebDriver wd => (Int, Int) -> Element -> wd ()+moveToFrom (x,y) (Element e) =+ noReturn . doSessCommand methodPost "/moveto"+ . triple ("element","xoffset","yoffset") $ (e,x,y)++-- |A mouse button+data MouseButton = LeftButton | MiddleButton | RightButton+ deriving (Eq, Show, Ord, Bounded, Enum)++instance ToJSON MouseButton where+ toJSON = toJSON . fromEnum++instance FromJSON MouseButton where+ parseJSON v = do+ n <- parseJSON v+ case n :: Integer of+ 0 -> return LeftButton+ 1 -> return MiddleButton+ 2 -> return RightButton+ err -> fail $ "Invalid JSON for MouseButton: " ++ show err++-- |Click at the current mouse position with the given mouse button.+clickWith :: WebDriver wd => MouseButton -> wd ()+clickWith = noReturn . doSessCommand methodPost "/click" . single "button"++-- |Perform the given action with the left mouse button held down. The mouse+-- is automatically released afterwards.+withMouseDown :: WebDriver wd => wd a -> wd a+withMouseDown wd = mouseDown >> wd <* mouseUp++-- |Press and hold the left mouse button down. Note that undefined behavior+-- occurs if the next mouse command is not mouseUp.+mouseDown :: WebDriver wd => wd ()+mouseDown = noReturn $ doSessCommand methodPost "/buttondown" Null++-- |Release the left mouse button.+mouseUp :: WebDriver wd => wd ()+mouseUp = noReturn $ doSessCommand methodPost "/buttonup" Null++-- |Double click at the current mouse location.+doubleClick :: WebDriver wd => wd ()+doubleClick = noReturn $ doSessCommand methodPost "/doubleclick" Null++-- |Single tap on the touch screen at the given element's location.+touchClick :: WebDriver wd => Element -> wd ()+touchClick (Element e) =+ noReturn . doSessCommand methodPost "/touch/click" . single "element" $ e++-- |Emulates pressing a finger down on the screen at the given location.+touchDown :: WebDriver wd => (Int, Int) -> wd ()+touchDown = noReturn . doSessCommand methodPost "/touch/down" . pair ("x","y")++-- |Emulates removing a finger from the screen at the given location.+touchUp :: WebDriver wd => (Int, Int) -> wd ()+touchUp = noReturn . doSessCommand methodPost "/touch/up" . pair ("x","y")++-- |Emulates moving a finger on the screen to the given location.+touchMove :: WebDriver wd => (Int, Int) -> wd ()+touchMove = noReturn . doSessCommand methodPost "/touch/move" . pair ("x","y")++-- |Emulate finger-based touch scroll. Use this function if you don't care where+-- the scroll begins+touchScroll :: WebDriver wd => (Int, Int) -> wd ()+touchScroll = noReturn . doSessCommand methodPost "/touch/scroll" . pair ("xoffset","yoffset")++-- |Emulate finger-based touch scroll, starting from the given location relative+-- to the given element.+touchScrollFrom :: WebDriver wd => (Int, Int) -> Element -> wd ()+touchScrollFrom (x, y) (Element e) =+ noReturn+ . doSessCommand methodPost "/touch/scroll"+ . triple ("xoffset", "yoffset", "element")+ $ (x, y, e)++-- |Emulate a double click on a touch device.+touchDoubleClick :: WebDriver wd => Element -> wd ()+touchDoubleClick (Element e) =+ noReturn+ . doSessCommand methodPost "/touch/doubleclick"+ . single "element" $ e++-- |Emulate a long click on a touch device.+touchLongClick :: WebDriver wd => Element -> wd ()+touchLongClick (Element e) =+ noReturn+ . doSessCommand methodPost "/touch/longclick"+ . single "element" $ e+-- |Emulate a flick on the touch screen. The coordinates indicate x and y+-- velocity, respectively. Use this function if you don't care where the+-- flick starts.+touchFlick :: WebDriver wd => (Int, Int) -> wd ()+touchFlick =+ noReturn+ . doSessCommand methodPost "/touch/flick"+ . pair ("xSpeed", "ySpeed")++-- |Emulate a flick on the touch screen.+touchFlickFrom :: WebDriver wd =>+ Int -- ^ flick velocity+ -> (Int, Int) -- ^ a location relative to the given element+ -> Element -- ^ the given element+ -> wd ()+touchFlickFrom s (x,y) (Element e) =+ noReturn+ . doSessCommand methodPost "/touch/flick" . object $+ ["xoffset" .= x+ ,"yoffset" .= y+ ,"speed" .= s+ ,"element" .= e+ ]++-- |Get the current geographical location of the device.+getLocation :: WebDriver wd => wd (Int, Int, Int)+getLocation = doSessCommand methodGet "/location" Null+ >>= parseTriple "latitude" "longitude" "altitude" "getLocation"++-- |Set the current geographical location of the device.+setLocation :: WebDriver wd => (Int, Int, Int) -> wd ()+setLocation = noReturn . doSessCommand methodPost "/location"+ . triple ("latitude",+ "longitude",+ "altitude")++-- |Uploads a file from the local filesystem by its file path.+uploadFile :: WebDriver wd => FilePath -> wd ()+uploadFile path = uploadZipEntry =<< liftBase (readEntry [] path)++-- |Uploads a raw bytestring with associated file info.+uploadRawFile :: WebDriver wd =>+ FilePath -- ^File path to use with this bytestring.+ -> Integer -- ^Modification time+ -- (in seconds since Unix epoch).+ -> LBS.ByteString -- ^ The file contents as a lazy ByteString+ -> wd ()+uploadRawFile path t str = uploadZipEntry (toEntry path t str)+++-- |Lowest level interface to the file uploading mechanism.+-- This allows you to specify the exact details of+-- the zip entry sent across network.+uploadZipEntry :: WebDriver wd => Entry -> wd ()+uploadZipEntry = noReturn . doSessCommand methodPost "/file" . single "file"+ . TL.decodeUtf8 . B64.encode . fromArchive . (`addEntryToArchive` emptyArchive)+++-- |Get the current number of keys in a web storage area.+storageSize :: WebDriver wd => WebStorageType -> wd Integer+storageSize s = doStorageCommand methodGet s "/size" Null++-- |Get a list of all keys from a web storage area.+getAllKeys :: WebDriver wd => WebStorageType -> wd [Text]+getAllKeys s = doStorageCommand methodGet s "" Null++-- |Delete all keys within a given web storage area.+deleteAllKeys :: WebDriver wd => WebStorageType -> wd ()+deleteAllKeys s = noReturn $ doStorageCommand methodDelete s "" Null++-- |An HTML 5 storage type+data WebStorageType = LocalStorage | SessionStorage+ deriving (Eq, Show, Ord, Bounded, Enum)++-- |Get the value associated with a key in the given web storage area.+-- 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 methodGet s ("/key/" `T.append` urlEncode k) Null++-- |Set a key in the given web storage area.+setKey :: WebDriver wd => WebStorageType -> Text -> Text -> wd Text+setKey s k v = doStorageCommand methodPost s "" . object $ ["key" .= k,+ "value" .= v ]+-- |Delete a key in the given web storage area.+deleteKey :: WebDriver wd => WebStorageType -> Text -> wd ()+deleteKey s k = noReturn $ doStorageCommand methodPost s ("/key/" `T.append` urlEncode k) Null++-- |A wrapper around 'doStorageCommand' to create web storage URLs.+doStorageCommand :: (WebDriver wd, ToJSON a, FromJSON b) =>+ Method -> WebStorageType -> Text -> a -> wd b+doStorageCommand m s path a = doSessCommand m (T.concat ["/", s', path]) a+ where s' = case s of+ LocalStorage -> "local_storage"+ SessionStorage -> "session_storage"++-- |Get information from the server as a JSON 'Object'. For more information+-- 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 methodGet "/status" Null++-- |A record that represents a single log entry.+data LogEntry =+ LogEntry { logTime :: Integer -- ^ timestamp for the log entry. The standard+ -- does not specify the epoch or the unit of+ -- time.+ , logLevel :: LogLevel -- ^ log verbosity level+ , logMsg :: Text+ }+ deriving (Eq, Ord, Show, Read)+++instance FromJSON LogEntry where+ parseJSON (Object o) =+ LogEntry <$> o .: "timestamp"+ <*> o .: "level"+ <*> (fromMaybe "" <$> o .: "message")+ parseJSON v = typeMismatch "LogEntry" v++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 methodPost "/log" . object $ ["type" .= t]++-- |Get a list of available log types.+getLogTypes :: WebDriver wd => wd [LogType]+getLogTypes = doSessCommand methodGet "/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 methodGet "/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 (defaultOptions{fieldLabelModifier = map C.toLower . drop 4}) ''Cookie )
+ src/Test/WebDriver/Commands/Internal.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}+{-# OPTIONS_HADDOCK not-home #-}+-- |Internal functions used to implement the functions exported by+-- "Test.WebDriver.Commands". These may be useful for implementing non-standard+-- webdriver commands.+module Test.WebDriver.Commands.Internal+ (-- * Low-level webdriver functions+ doCommand+ -- ** Commands with :sessionId URL parameter+ , doSessCommand, SessionId(..)+ -- ** Commands with element :id URL parameters+ , doElemCommand, Element(..)+ -- ** Commands with :windowHandle URL parameters+ , doWinCommand, WindowHandle(..), currentWindow+ -- * Exceptions+ , NoSessionId(..)+ ) where++import Test.WebDriver.Class+import Test.WebDriver.Session+import Test.WebDriver.Utils (urlEncode)++import Data.Aeson+import Data.Aeson.Types+import Data.Text (Text)+import qualified Data.Text as T+import Control.Exception.Lifted+import Data.Typeable+import Data.Default+import Control.Applicative++{- |An opaque identifier for a web page element. -}+newtype Element = Element Text+ deriving (Eq, Ord, Show, Read)++instance FromJSON Element where+ parseJSON (Object o) = Element <$> o .: "ELEMENT"+ parseJSON v = typeMismatch "Element" v++instance ToJSON Element where+ toJSON (Element e) = object ["ELEMENT" .= e]+++{- |An opaque identifier for a browser window -}+newtype WindowHandle = WindowHandle Text+ deriving (Eq, Ord, Show, Read,+ FromJSON, ToJSON)+instance Default WindowHandle where+ def = currentWindow++-- |A special 'WindowHandle' that always refers to the currently focused window.+-- This is also used by the 'Default' instance.+currentWindow :: WindowHandle+currentWindow = WindowHandle "current"++instance Exception NoSessionId+-- |A command requiring a session ID was attempted when no session ID was+-- available.+newtype NoSessionId = NoSessionId String+ deriving (Eq, Show, Typeable)++-- |This a convenient wrapper around 'doCommand' that automatically prepends+-- the session URL parameter to the wire command URL. For example, passing+-- a URL of \"/refresh\" will expand to \"/session/:sessionId/refresh\", where+-- :sessionId is a URL parameter as described in+-- <http://code.google.com/p/selenium/wiki/JsonWireProtocol>+doSessCommand :: (WebDriver wd, ToJSON a, FromJSON b) =>+ Method -> Text -> a -> wd b+doSessCommand method path args = do+ WDSession { wdSessId = mSessId } <- getSession+ case mSessId of+ Nothing -> throwIO . NoSessionId $ msg+ where+ msg = "doSessCommand: No session ID found for relative URL "+ ++ show path+ Just (SessionId sId) -> doCommand method+ (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+-- \"/session/:sessionId/element/:id/active\", where :sessionId and :id are URL+-- parameters as described in the wire protocol.+doElemCommand :: (WebDriver wd, ToJSON a, FromJSON b) =>+ Method -> Element -> Text -> a -> wd b+doElemCommand m (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+-- \"/session/:sessionId/window/:windowHandle/\", where :sessionId and+-- :windowHandle are URL parameters as described in the wire protocol+doWinCommand :: (WebDriver wd, ToJSON a, FromJSON b) =>+ Method -> WindowHandle -> Text -> a -> wd b+doWinCommand m (WindowHandle w) path a =+ doSessCommand m (T.concat ["/window/", urlEncode w, path]) a
+ src/Test/WebDriver/Commands/Wait.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE CPP, DeriveDataTypeable, ScopedTypeVariables, FlexibleContexts #-}+module Test.WebDriver.Commands.Wait+ ( -- * Wait on expected conditions+ waitUntil, waitUntil'+ , waitWhile, waitWhile'+ -- * Expected conditions+ , ExpectFailed, expect, unexpected+ -- ** Convenience functions+ , onTimeout+ , expectAny, expectAll+ , ifM, (<||>), (<&&>), notM+ ) where+import Test.WebDriver.Exceptions+import Test.WebDriver.Session++import Control.Monad.Base+import Control.Monad.Trans.Control+import Control.Exception.Lifted+import Control.Concurrent+import Control.Conditional (ifM, (<||>), (<&&>), notM)++import Data.Time.Clock+import Data.Typeable+++#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706+import Prelude hiding (catch)+#endif++instance Exception ExpectFailed+-- |An exception representing the failure of an expected condition.+data ExpectFailed = ExpectFailed String deriving (Show, Eq, Typeable)++-- |throws 'ExpectFailed'. This is nice for writing your own abstractions.+unexpected :: MonadBaseControl IO m =>+ String -- ^ Reason why the expected condition failed.+ -> m a+unexpected = throwIO . ExpectFailed++-- |An expected condition. This function allows you to express assertions in+-- your explicit wait. This function raises 'ExpectFailed' if the given+-- boolean is False, and otherwise does nothing.+expect :: MonadBaseControl IO m => Bool -> m ()+expect b+ | b = return ()+ | otherwise = unexpected "Test.WebDriver.Commands.Wait.expect"++-- |Apply a monadic predicate to every element in a list, and 'expect' that+-- at least one succeeds.+expectAny :: MonadBaseControl IO m => (a -> m Bool) -> [a] -> m ()+expectAny p xs = expect . or =<< mapM p xs++-- |Apply a monadic predicate to every element in a list, and 'expect' that all+-- succeed.+expectAll :: MonadBaseControl IO m => (a -> m Bool) -> [a] -> m ()+expectAll p xs = expect . and =<< mapM p xs++-- |Wait until either the given action succeeds or the timeout is reached.+-- The action will be retried every .5 seconds until no 'ExpectFailed' or+-- 'FailedCommand' 'NoSuchElement' exceptions occur. If the timeout is reached,+-- then a 'Timeout' exception will be raised. The timeout value+-- is expressed in seconds.+waitUntil :: (WDSessionState m) => Double -> m a -> m a+waitUntil = waitUntil' 500000++-- |Similar to 'waitUntil' but allows you to also specify the poll frequency+-- of the 'WD' action. The frequency is expressed as an integer in microseconds.+waitUntil' :: (WDSessionState m) => Int -> Double -> m a -> m a+waitUntil' = waitEither id (\_ -> return)++-- |Like 'waitUntil', but retries the action until it fails or until the timeout+-- is exceeded.+waitWhile :: (WDSessionState m) => Double -> m a -> m ()+waitWhile = waitWhile' 500000++-- |Like 'waitUntil'', but retries the action until it either fails or+-- until the timeout is exceeded.+waitWhile' :: (WDSessionState m) => Int -> Double -> m a -> m ()+waitWhile' =+ waitEither (\_ _ -> return ())+ (\retry _ -> retry "waitWhile: action did not fail")+++-- |Internal function used to implement explicit wait commands using success and failure continuations+waitEither :: (WDSessionState m) =>+ ((String -> m b) -> String -> m b)+ -> ((String -> m b) -> a -> m b)+ -> Int -> Double -> m a -> m b+waitEither failure success = wait' handler+ where+ handler retry wd = do+ e <- fmap Right wd `catches` [Handler handleFailedCommand+ ,Handler handleExpectFailed+ ]+ either (failure retry) (success retry) e+ where+ handleFailedCommand e@(FailedCommand NoSuchElement _) = return . Left . show $ e+ handleFailedCommand err = throwIO err++ handleExpectFailed (e :: ExpectFailed) = return . Left . show $ e++wait' :: (WDSessionState m) =>+ ((String -> m b) -> m a -> m b) -> Int -> Double -> m a -> m b+wait' handler waitAmnt t wd = waitLoop =<< liftBase getCurrentTime+ where+ timeout = realToFrac t+ waitLoop startTime = handler retry wd+ where+ retry why = do+ now <- liftBase getCurrentTime+ if diffUTCTime now startTime >= timeout+ then+ failedCommand Timeout $ "wait': explicit wait timed out (" ++ why ++ ")."+ else do+ liftBase . threadDelay $ waitAmnt+ waitLoop startTime++-- |Convenience function to catch 'FailedCommand' 'Timeout' exceptions+-- and perform some action.+--+-- Example:+--+-- > waitUntil 5 (getText <=< findElem $ ByCSS ".class")+-- > `onTimeout` return ""+onTimeout :: MonadBaseControl IO m => m a -> m a -> m a+onTimeout m r = m `catch` handler+ where+ handler (FailedCommand Timeout _) = r+ handler other = throwIO other
+ src/Test/WebDriver/Common/Profile.hs view
@@ -0,0 +1,258 @@+{-# LANGUAGE CPP, TypeSynonymInstances, DeriveDataTypeable, FlexibleInstances,+ GeneralizedNewtypeDeriving, OverloadedStrings, FlexibleContexts #-}+{-# OPTIONS_HADDOCK not-home #-}+-- |A type for profile preferences. These preference values are used by both+-- Firefox and Opera profiles.+module Test.WebDriver.Common.Profile+ ( -- *Profiles and profile preferences+ Profile(..), PreparedProfile(..), ProfilePref(..), ToPref(..)+ -- * Preferences+ , getPref, addPref, deletePref+ -- * Extensions+ , addExtension, deleteExtension, hasExtension+ -- * Other files and directories+ , addFile, deleteFile, hasFile+ -- * Miscellaneous profile operations+ , unionProfiles, onProfileFiles, onProfilePrefs+ -- *Preparing profiles from disk+ , prepareLoadedProfile_+ -- *Preparing zipped profiles+ , prepareZippedProfile, prepareZipArchive,+ prepareRawZip+ -- *Profile errors+ , ProfileParseError(..)+ ) where++import System.Directory+import System.FilePath hiding (addExtension, hasExtension)+import Codec.Archive.Zip+import Data.Aeson+import Data.Aeson.Types++#if MIN_VERSION_aeson(0,7,0)+import Data.Scientific+#else+import Data.Attoparsec.Number (Number(..))+#endif++import qualified Data.HashMap.Strict as HM+import Data.Text (Text, pack)+import Data.ByteString.Lazy (ByteString)+--import qualified Data.ByteString as SBS+import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString.Base64.Lazy as B64+import qualified Data.Text.Lazy.Encoding as TL+++import Data.Fixed+import Data.Ratio+import Data.Int+import Data.Word+import Data.Typeable++import Control.Exception+import Control.Applicative+import Control.Monad.Base++-- |This structure allows you to construct and manipulate profiles in pure code,+-- deferring execution of IO operations until the profile is \"prepared\". This+-- type is shared by both Firefox and Opera profiles; when a distinction+-- must be made, the phantom type parameter is used to differentiate.+data Profile b = Profile+ { -- |A mapping from relative destination filepaths to source+ -- filepaths found on the filesystem. When the profile is+ -- prepared, these source filepaths will be moved to their+ -- destinations within the profile directory.+ --+ -- Using the destination path as the key ensures that+ -- there is one unique source path going to each+ -- destination path.+ profileFiles :: HM.HashMap FilePath FilePath+ -- |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+ }+ deriving (Eq, Show)++-- |Represents a profile that has been prepared for+-- network transmission. The profile cannot be modified in this form.+newtype PreparedProfile b = PreparedProfile ByteString+ deriving (Eq, Show)++instance FromJSON (PreparedProfile s) where+ parseJSON v = PreparedProfile . TL.encodeUtf8 <$> parseJSON v++instance ToJSON (PreparedProfile s) where+ toJSON (PreparedProfile s) = toJSON $ TL.decodeUtf8 s++-- |A profile preference value. This is the subset of JSON values that excludes+-- arrays, objects, and null.+data ProfilePref = PrefInteger !Integer+ | PrefDouble !Double+ | PrefString !Text+ | PrefBool !Bool+ deriving (Eq, Show)++instance ToJSON ProfilePref where+ toJSON v = case v of+ PrefInteger i -> toJSON i+ PrefDouble d -> toJSON d+ PrefString s -> toJSON s+ PrefBool b -> toJSON b++instance FromJSON ProfilePref where+ parseJSON (String s) = return $ PrefString s+ parseJSON (Bool b) = return $ PrefBool b+#if MIN_VERSION_aeson(0,7,0)+ parseJSON (Number s) | base10Exponent s >= 0 = return $ PrefInteger (coefficient s * 10^(base10Exponent s))+ | otherwise = return $ PrefDouble $ realToFrac s+#else+ parseJSON (Number (I i)) = return $ PrefInteger i+ parseJSON (Number (D d)) = return $ PrefDouble d+#endif+ parseJSON other = typeMismatch "ProfilePref" other++instance Exception ProfileParseError+-- |An error occured while attempting to parse a profile's preference file.+newtype ProfileParseError = ProfileParseError String+ deriving (Eq, Show, Read, Typeable)++-- |A typeclass to convert types to profile preference values+class ToPref a where+ toPref :: a -> ProfilePref++instance ToPref Text where+ toPref = PrefString++instance ToPref String where+ toPref = toPref . pack++instance ToPref Bool where+ toPref = PrefBool++instance ToPref Integer where+ toPref = PrefInteger++#define I(t) instance ToPref t where toPref = PrefInteger . toInteger++I(Int)+I(Int8)+I(Int16)+I(Int32)+I(Int64)+I(Word)+I(Word8)+I(Word16)+I(Word32)+I(Word64)++instance ToPref Double where+ toPref = PrefDouble++instance ToPref Float where+ toPref = PrefDouble . realToFrac++instance (Integral a) => ToPref (Ratio a) where+ toPref = PrefDouble . realToFrac++instance (HasResolution r) => ToPref (Fixed r) where+ toPref = PrefDouble . realToFrac+++-- |Retrieve a preference from a profile by key name.+getPref :: Text -> Profile b -> Maybe ProfilePref+getPref k (Profile _ m) = HM.lookup k m++-- |Add a new preference entry to a profile, overwriting any existing entry+-- with the same key.+addPref :: ToPref a => Text -> a -> Profile b -> Profile b+addPref k v p = onProfilePrefs p $ HM.insert k (toPref v)++-- |Delete an existing preference entry from a profile. This operation is+-- silent if the preference wasn't found.+deletePref :: Text -> Profile b -> Profile b+deletePref k p = onProfilePrefs p $ HM.delete k++-- |Add a file to the profile directory. The first argument is the source+-- of the file on the local filesystem. The second argument is the destination+-- as a path relative to a profile directory. Overwrites any file that+-- previously pointed to the same destination+addFile :: FilePath -> FilePath -> Profile b -> Profile b+addFile src dest p = onProfileFiles p $ HM.insert dest src++-- |Delete a file from the profile directory. The first argument is the name of+-- file within the profile directory.+deleteFile :: FilePath -> Profile b -> Profile b+deleteFile path prof = onProfileFiles prof $ HM.delete path++-- |Determines if a profile contains the given file, specified as a path+-- relative to the profile directory.+hasFile :: String -> Profile b -> Bool+hasFile path (Profile files _) = path `HM.member` files++-- |Add a new extension to the profile. The file path should refer to+-- a .xpi file or an extension directory on the filesystem.+addExtension :: FilePath -> Profile b -> Profile b+addExtension path = addFile path ("extensions" </> name)+ where (_, name) = splitFileName path++-- |Delete an existing extension from the profile. The string parameter+-- should refer to an .xpi file or directory located within the extensions+-- directory of the profile. This operation has no effect if the extension was+-- never added to the profile.+deleteExtension :: String -> Profile b -> Profile b+deleteExtension name = deleteFile ("extensions" </> name)++-- |Determines if a profile contains the given extension. specified as an+-- .xpi file or directory name+hasExtension :: String -> Profile b -> Bool+hasExtension name prof = hasFile ("extensions" </> name) prof+++-- |Takes the union of two profiles. This is the union of their 'HashMap'+-- fields.+unionProfiles :: Profile b -> Profile b -> Profile b+unionProfiles (Profile f1 p1) (Profile f2 p2)+ = Profile (f1 `HM.union` f2) (p1 `HM.union` p2)++-- |Modifies the 'profilePrefs' field of a profile.+onProfilePrefs :: Profile b+ -> (HM.HashMap Text ProfilePref+ -> HM.HashMap Text ProfilePref)+ -> Profile b+onProfilePrefs (Profile hs hm) f = Profile hs (f hm)++-- |Modifies the 'profileFiles' field of a profile+onProfileFiles :: Profile b+ -> (HM.HashMap FilePath FilePath+ -> HM.HashMap FilePath FilePath)+ -> Profile b+onProfileFiles (Profile ls hm) f = Profile (f ls) hm+++-- |Efficiently load an existing profile from disk and prepare it for network+-- transmission.+prepareLoadedProfile_ :: MonadBase IO m =>+ FilePath -> m (PreparedProfile a)+prepareLoadedProfile_ path = liftBase $ do+ oldWd <- getCurrentDirectory+ setCurrentDirectory path+ prepareZipArchive <$>+ liftBase (addFilesToArchive [OptRecursive]+ emptyArchive ["."])+ <* setCurrentDirectory oldWd++-- |Prepare a zip file of a profile on disk for network transmission.+-- This function is very efficient at loading large profiles from disk.+prepareZippedProfile :: MonadBase IO m =>+ FilePath -> m (PreparedProfile a)+prepareZippedProfile path = prepareRawZip <$> liftBase (LBS.readFile path)++-- |Prepare a zip archive of a profile for network transmission.+prepareZipArchive :: Archive -> PreparedProfile a+prepareZipArchive = prepareRawZip . fromArchive++-- |Prepare a ByteString of raw zip data for network transmission+prepareRawZip :: ByteString -> PreparedProfile a+prepareRawZip = PreparedProfile . B64.encode
+ src/Test/WebDriver/Config.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleContexts #-}+module Test.WebDriver.Config(+ -- * WebDriver configuration+ WDConfig(..), defaultConfig, mkSession + ) where+import Test.WebDriver.Session+import Test.WebDriver.Capabilities++import Data.Default (Default, def)+import Data.String (fromString)++import Network.HTTP.Client (Manager, newManager, defaultManagerSettings) ++import Control.Monad.Base (MonadBase, liftBase)++-- |WebDriver session configuration+data WDConfig = WDConfig {+ -- |Host name of the WebDriver server for this+ -- session (default 127.0.0.1)+ wdHost :: String+ -- |Port number of the server (default 4444)+ , wdPort :: Int+ -- |Capabilities to use for this session+ , wdCapabilities :: Capabilities+ -- |Whether or not we should keep a history of HTTP requests/responses+ --+ -- By default, only the last request/response pair is stored (O(1) heap consumption).+ -- Enable this option for more detailed debugging info for HTTP requests.+ , wdKeepSessHist :: Bool+ -- |Base path for all API requests (default "/wd/hub")+ , wdBasePath :: String+ -- |Use the given http-client 'Manager' instead of the default+ , wdHTTPManager :: Maybe Manager++}++instance Default WDConfig where+ def = WDConfig {+ wdHost = "127.0.0.1"+ , wdPort = 4444+ , wdCapabilities = def+ , wdKeepSessHist = False + , wdBasePath = "/wd/hub"+ , wdHTTPManager = Nothing+ }+ +{- |A default session config connects to localhost on port 4444, and hasn't been+initialized server-side. This value is the same as 'def' but with a less+polymorphic type. -}+defaultConfig :: WDConfig+defaultConfig = def+ +-- |Constructs a new 'WDSession' from a given 'WDConfig'+mkSession :: MonadBase IO m => WDConfig -> m WDSession+mkSession WDConfig{..} = do+ manager <- maybe createManager return wdHTTPManager+ return WDSession { wdSessHost = fromString $ wdHost+ , wdSessPort = wdPort+ , wdSessBasePath = fromString $ wdBasePath+ , wdSessId = Nothing+ , wdSessHist = []+ , wdSessHistUpdate = histUpdate+ , wdSessHTTPManager = manager }+ where+ createManager = liftBase $ newManager defaultManagerSettings+ histUpdate+ | wdKeepSessHist = (:)+ | otherwise = \x _ -> [x]+ +++ ++
+ src/Test/WebDriver/Exceptions.hs view
@@ -0,0 +1,11 @@+module Test.WebDriver.Exceptions+ ( InvalidURL(..), NoSessionId(..), BadJSON(..)+ , HTTPStatusUnknown(..), HTTPConnError(..)+ , UnknownCommand(..), ServerError(..)+ , FailedCommand(..), FailedCommandType(..)+ , FailedCommandInfo(..), StackFrame(..)+ , mkFailedCommandInfo, failedCommand+ )where+import Test.WebDriver.Internal+import Test.WebDriver.JSON+import Test.WebDriver.Commands.Internal
+ src/Test/WebDriver/Firefox/Profile.hs view
@@ -0,0 +1,237 @@+{-# LANGUAGE CPP, OverloadedStrings, FlexibleContexts,+ GeneralizedNewtypeDeriving, EmptyDataDecls,+ ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} -- suppress warnings from attoparsec+-- |A module for working with Firefox profiles. Firefox profiles are manipulated+-- in pure code and then \"prepared\" for network transmission.+module Test.WebDriver.Firefox.Profile+ ( -- * Profiles+ Firefox, Profile(..), PreparedProfile+ , defaultProfile+ -- * Preferences+ , ProfilePref(..), ToPref(..)+ , addPref, getPref, deletePref+ -- * Extensions+ , addExtension, deleteExtension, hasExtension+ -- * Other files and directories+ , addFile, deleteFile, hasFile+ -- * Miscellaneous profile operations+ , unionProfiles, onProfileFiles, onProfilePrefs+ -- * Loading and preparing profiles+ , prepareProfile, prepareTempProfile+ -- ** Preparing profiles from disk+ , loadProfile, prepareLoadedProfile, prepareLoadedProfile_+ -- ** Preparing zip archives+ , prepareZippedProfile, prepareZipArchive, prepareRawZip+ -- ** Preferences parsing error+ , ProfileParseError(..)+ ) where+import Test.WebDriver.Common.Profile+import Data.Aeson+import Data.Aeson.Parser (jstring, value')+import Data.Attoparsec.Char8 as AP+import qualified Data.HashMap.Strict as HM+import Data.Text (Text)+import Data.ByteString as BS (readFile)+import qualified Data.ByteString.Lazy.Char8 as LBS++import System.FilePath hiding (addExtension, hasExtension)+import System.Directory+import System.IO.Temp (createTempDirectory)+import qualified System.Directory.Tree as DS++import Control.Monad+import Control.Monad.Base+import Control.Monad.Trans.Control+import Control.Exception.Lifted hiding (try)+import Control.Applicative+import Control.Arrow++#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706+import Prelude hiding (catch)+#endif++-- |Phantom type used in the parameters of 'Profile' and 'PreparedProfile'+data Firefox++-- |Default Firefox Profile, used when no profile is supplied.+defaultProfile :: Profile Firefox+defaultProfile =+ Profile HM.empty+ $ HM.fromList [("app.update.auto", PrefBool False)+ ,("app.update.enabled", PrefBool False)+ ,("browser.startup.page" , PrefInteger 0)+ ,("browser.download.manager.showWhenStarting", PrefBool False)+ ,("browser.EULA.override", PrefBool True)+ ,("browser.EULA.3.accepted", PrefBool True)+ ,("browser.link.open_external", PrefInteger 2)+ ,("browser.link.open_newwindow", PrefInteger 2)+ ,("browser.offline", PrefBool False)+ ,("browser.safebrowsing.enabled", PrefBool False)+ ,("browser.search.update", PrefBool False)+ ,("browser.sessionstore.resume_from_crash", PrefBool False)+ ,("browser.shell.checkDefaultBrowser", PrefBool False)+ ,("browser.tabs.warnOnClose", PrefBool False)+ ,("browser.tabs.warnOnOpen", PrefBool False)+ ,("browser.startup.page", PrefInteger 0)+ ,("browser.safebrowsing.malware.enabled", PrefBool False)+ ,("startup.homepage_welcome_url", PrefString "about:blank")+ ,("devtools.errorconsole.enabled", PrefBool True)+ ,("focusmanager.testmode", PrefBool True)+ ,("dom.disable_open_during_load", PrefBool False)+ ,("extensions.autoDisableScopes" , PrefInteger 10)+ ,("extensions.logging.enabled", PrefBool True)+ ,("extensions.update.enabled", PrefBool False)+ ,("extensions.update.notifyUser", PrefBool False)+ ,("network.manage-offline-status", PrefBool False)+ ,("network.http.max-connections-per-server", PrefInteger 10)+ ,("network.http.phishy-userpass-length", PrefInteger 255)+ ,("offline-apps.allow_by_default", PrefBool True)+ ,("prompts.tab_modal.enabled", PrefBool False)+ ,("security.fileuri.origin_policy", PrefInteger 3)+ ,("security.fileuri.strict_origin_policy", PrefBool False)+ ,("security.warn_entering_secure", PrefBool False)+ ,("security.warn_submit_insecure", PrefBool False)+ ,("security.warn_entering_secure.show_once", PrefBool False)+ ,("security.warn_entering_weak", PrefBool False)+ ,("security.warn_entering_weak.show_once", PrefBool False)+ ,("security.warn_leaving_secure", PrefBool False)+ ,("security.warn_leaving_secure.show_once", PrefBool False)+ ,("security.warn_submit_insecure", PrefBool False)+ ,("security.warn_viewing_mixed", PrefBool False)+ ,("security.warn_viewing_mixed.show_once", PrefBool False)+ ,("signon.rememberSignons", PrefBool False)+ ,("toolkit.networkmanager.disable", PrefBool True)+ ,("toolkit.telemetry.enabled", PrefBool False)+ ,("toolkit.telemetry.prompted", PrefInteger 2)+ ,("toolkit.telemetry.rejected", PrefBool True)+ ,("javascript.options.showInConsole", PrefBool True)+ ,("browser.dom.window.dump.enabled", PrefBool True)+ ,("webdriver_accept_untrusted_certs", PrefBool True)+ ,("webdriver_enable_native_events", native_events)+ ,("webdriver_assume_untrusted_issuer", PrefBool True)+ ,("dom.max_script_run_time", PrefInteger 30)+ ]+ where+#ifdef darwin_HOST_OS+ native_events = PrefBool False+#else+ native_events = PrefBool True+#endif+++-- |Load an existing profile from the file system. Any prepared changes made to+-- the 'Profile' will have no effect to the profile on disk.+--+-- To make automated browser run smoothly, preferences found in+-- 'defaultProfile' are automatically merged into the preferences of the on-disk-- profile. The on-disk profile's preference will override those found in the+-- default profile.+loadProfile :: MonadBaseControl IO m => FilePath -> m (Profile Firefox)+loadProfile path = liftBase $ do+ unionProfiles defaultProfile <$> (Profile <$> getFiles <*> getPrefs)+ where+ userPrefFile = path </> "prefs" <.> "js"++ getFiles = HM.fromList . map (id &&& (path </>)) . filter isNotIgnored+ <$> getDirectoryContents path+ where isNotIgnored = (`notElem`+ [".", "..", "OfflineCache", "Cache"+ ,"parent.lock", ".parentlock", ".lock"+ ,userPrefFile])++ getPrefs = HM.fromList <$> (parsePrefs =<< BS.readFile userPrefFile)+ where parsePrefs s = either (throwIO . ProfileParseError) return+ $ parseOnly prefsParser s++-- |Prepare a firefox profile for network transmission.+-- Internally, this function constructs a Firefox profile within a temp+-- directory, archives it as a zip file, and then base64 encodes the zipped+-- data. The temporary directory is deleted afterwards.+--+-- NOTE: because this function has to copy the profile files into a+-- a temp directory before zip archiving them, this operation is likely to be slow+-- for large profiles. In such a case, consider using 'prepareLoadedProfile_' or+-- 'prepareZippedProfile' instead.+prepareProfile :: MonadBaseControl IO m =>+ Profile Firefox -> m (PreparedProfile Firefox)+prepareProfile Profile {profileFiles = files, profilePrefs = prefs}+ = liftBase $ do+ tmpdir <- mkTemp+ mapM_ (installPath tmpdir) . HM.toList $ files+ installUserPrefs tmpdir+ prepareLoadedProfile_ tmpdir+-- <* removeDirectoryRecursive tmpdir+ where+ installPath destDir (destPath, src) = do+ let dest = destDir </> destPath+ isDir <- doesDirectoryExist src+ if isDir+ then do+ createDirectoryIfMissing True dest `catch` ignoreIOException+ (_ DS.:/ dir) <- DS.readDirectoryWithL LBS.readFile src+ handle ignoreIOException . void+ $ DS.writeDirectoryWith LBS.writeFile (dest DS.:/ dir)+ else do+ let dir = takeDirectory dest+ when (not . null $ dir) $+ createDirectoryIfMissing True dir `catch` ignoreIOException+ copyFile src dest `catch` ignoreIOException+ where+ ignoreIOException :: IOException -> IO ()+ ignoreIOException = print++ installUserPrefs d = LBS.writeFile (d </> "user" <.> "js") str+ where+ str = LBS.concat+ . map (\(k, v) -> LBS.concat [ "user_pref(", encode k,+ ", ", encode v, ");\n"])+ . HM.toList $ prefs++-- |Apply a function on a default profile, and+-- prepare the result. The Profile passed to the handler function is+-- the default profile used by sessions when Nothing is specified+prepareTempProfile :: MonadBaseControl IO m =>+ (Profile Firefox -> Profile Firefox)+ -> m (PreparedProfile Firefox)+prepareTempProfile f = prepareProfile . f $ defaultProfile++-- |Convenience function to load an existing Firefox profile from disk, apply+-- a handler function, and then prepare the result for network transmission.+--+-- NOTE: like 'prepareProfile', the same caveat about large profiles applies.+prepareLoadedProfile :: MonadBaseControl IO m =>+ FilePath+ -> (Profile Firefox -> Profile Firefox)+ -> m (PreparedProfile Firefox)+prepareLoadedProfile path f = liftM f (loadProfile path) >>= prepareProfile++-- firefox prefs.js parser++prefsParser :: Parser [(Text, ProfilePref)]+prefsParser = many1 $ do+ void . padSpaces $ string "user_pref("+ k <- prefKey <?> "preference key"+ void . padSpaces $ char ','+ v <- prefVal <?> "preference value"+ void . padSpaces $ string ");"+ return (k,v)+ where+ prefKey = jstring+ prefVal = do+ v <- value'+ case fromJSON v of+ Error str -> fail str+ Success p -> return p++ padSpaces p = spaces >> p <* spaces+ spaces = many (endOfLine <|> void space <|> void comment)+ where+ comment = inlineComment <|> lineComment+ lineComment = char '#' *> manyTill anyChar endOfLine+ inlineComment = string "/*" *> manyTill anyChar (string "*/")+++mkTemp :: IO FilePath+mkTemp = do+ d <- getTemporaryDirectory+ createTempDirectory d ""
+ src/Test/WebDriver/Internal.hs view
@@ -0,0 +1,347 @@+{-# LANGUAGE FlexibleContexts, OverloadedStrings, DeriveDataTypeable,+ RecordWildCards, ScopedTypeVariables #-}+-- |The HTTP/JSON plumbing used to implement the 'WD' monad.+--+-- These functions can be used to create your own 'WebDriver' instances, providing extra functionality for your application if desired. All exports+-- of this module are subject to change at any point.+module Test.WebDriver.Internal+ ( mkRequest, sendHTTPRequest+ , getJSONResult, handleJSONErr, handleRespSessionId+ , WDResponse(..)++ , InvalidURL(..), HTTPStatusUnknown(..), HTTPConnError(..)+ , UnknownCommand(..), ServerError(..)++ , FailedCommand(..), failedCommand, mkFailedCommandInfo+ , FailedCommandType(..), FailedCommandInfo(..), StackFrame(..)+ ) where+import Test.WebDriver.Class+import Test.WebDriver.JSON+import Test.WebDriver.Session++import Network.HTTP.Client (httpLbs, Request(..), RequestBody(..), Response(..))+import Network.HTTP.Types.Header+import Network.HTTP.Types.Status (Status(..))+import Data.Aeson+import Data.Aeson.Types (Parser, typeMismatch)++import Data.Text as T (Text, splitOn, null)+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Lazy.Encoding as TLE+import Data.ByteString.Lazy.Char8 (ByteString)+import Data.ByteString.Lazy.Char8 as LBS (length, unpack, null, fromChunks)+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Base64.Lazy as B64+++import Control.Monad.Base+import Control.Exception.Lifted (throwIO)+import Control.Applicative+import Control.Exception (SomeException, toException)++import Control.Exception (Exception)+import Data.Typeable (Typeable)+import Data.Maybe (fromMaybe)+import Data.String (fromString)+import Data.Word (Word, Word8)+import Data.Default++-- |Constructs an HTTP 'Request' value when given a list of headers, HTTP request method, and URL fragment+mkRequest :: (WDSessionState s, ToJSON a) =>+ RequestHeaders -> Method -> Text -> a -> s Request+mkRequest headers meth wdPath args = do+ WDSession {..} <- getSession+ let body = case toJSON args of+ Null -> "" --passing Null as the argument indicates no request body+ other -> encode other+ return def { host = wdSessHost+ , port = wdSessPort+ , path = wdSessBasePath `BS.append` TE.encodeUtf8 wdPath+ , requestBody = RequestBodyLBS body+ , requestHeaders = headers ++ [ (hAccept, "application/json;charset=UTF-8")+ , (hContentType, "application/json;charset=UTF-8")+ , (hContentLength, fromString . show . LBS.length $ body) ]+ , checkStatus = \_ _ _ -> Nothing -- all status codes handled by getJSONResult+ , method = meth }++-- |Sends an HTTP request to the remote WebDriver server+sendHTTPRequest :: (WDSessionState s) => Request -> s (Response ByteString)+sendHTTPRequest req = do+ s@WDSession{..} <- getSession+ res <- liftBase $ httpLbs req wdSessHTTPManager+ putSession s {wdSessHist = wdSessHistUpdate (req, res) wdSessHist} + return res+ + +-- |Parses a 'WDResponse' object from a given HTTP response.+getJSONResult :: (WDSessionState s, FromJSON a) => Response ByteString -> s (Either SomeException a)+getJSONResult r+ --malformed request errors+ | code >= 400 && code < 500 = do+ lastReq <- lastHTTPRequest <$> getSession+ returnErr . UnknownCommand . maybe reason show $ lastReq+ --server-side errors+ | code >= 500 && code < 600 = + case lookup hContentType headers of+ Just ct+ | "application/json" `BS.isInfixOf` ct ->+ parseJSON' + (maybe body (LBS.fromChunks . (:[])) (lookup "X-Response-Body-Start" headers))+ >>= handleJSONErr+ >>= maybe noReturn returnErr+ | otherwise -> + returnHTTPErr ServerError+ Nothing ->+ returnHTTPErr (ServerError . ("HTTP response missing content type. Server reason was: "++))+ --redirect case (used as a response to createSession requests) + | code == 302 || code == 303 =+ case lookup hLocation headers of+ Nothing -> returnErr . HTTPStatusUnknown code $ LBS.unpack body+ Just loc -> do+ let sessId = last . filter (not . T.null) . splitOn "/" . fromString $ BS.unpack loc+ modifySession $ \sess -> sess {wdSessId = Just (SessionId sessId)}+ noReturn+ -- No Content response+ | code == 204 = noReturn+ -- HTTP Success+ | code >= 200 && code < 300 = + if LBS.null body+ then noReturn+ else do+ rsp@WDResponse {rspVal = val} <- parseJSON' body + handleJSONErr rsp >>= maybe + (handleRespSessionId rsp >> Right <$> fromJSON' val)+ returnErr + -- other status codes: return error+ | otherwise = returnHTTPErr (HTTPStatusUnknown code)+ where+ --helper functions+ returnErr :: (Exception e, Monad m) => e -> m (Either SomeException a)+ returnErr = return . Left . toException+ returnHTTPErr errType = returnErr . errType $ reason+ noReturn = Right <$> fromJSON' Null+ --HTTP response variables+ code = statusCode status+ reason = BS.unpack $ statusMessage status+ status = responseStatus r + body = responseBody r + headers = responseHeaders r++handleRespSessionId :: (WDSessionState s) => WDResponse -> s ()+handleRespSessionId WDResponse{rspSessId = sessId'} = do+ sess@WDSession { wdSessId = sessId} <- getSession+ 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 ++ ")"+ _ -> return ()+ +handleJSONErr :: (WDSessionState s) => WDResponse -> s (Maybe SomeException)+handleJSONErr WDResponse{rspStatus = 0} = return Nothing+handleJSONErr WDResponse{rspVal = val, rspStatus = status} = do+ sess <- getSession+ errInfo <- fromJSON' val+ let screen = B64.decodeLenient <$> errScreen errInfo+ errInfo' = errInfo { errSess = Just sess+ , errScreen = screen }+ e errType = toException $ FailedCommand errType errInfo'+ return . Just $ case status of+ 7 -> e NoSuchElement+ 8 -> e NoSuchFrame+ 9 -> toException . UnknownCommand . errMsg $ errInfo+ 10 -> e StaleElementReference+ 11 -> e ElementNotVisible+ 12 -> e InvalidElementState+ 13 -> e UnknownError+ 15 -> e ElementIsNotSelectable+ 17 -> e JavascriptError+ 19 -> e XPathLookupError+ 21 -> e Timeout+ 23 -> e NoSuchWindow+ 24 -> e InvalidCookieDomain+ 25 -> e UnableToSetCookie+ 26 -> e UnexpectedAlertOpen+ 27 -> e NoAlertOpen+ 28 -> e ScriptTimeout+ 29 -> e InvalidElementCoordinates+ 30 -> e IMENotAvailable+ 31 -> e IMEEngineActivationFailed+ 32 -> e InvalidSelector+ 33 -> e SessionNotCreated+ 34 -> e MoveTargetOutOfBounds+ 51 -> e InvalidXPathSelector+ 52 -> e InvalidXPathSelectorReturnType+ _ -> e UnknownError+++-- |Internal type representing the JSON response object+data WDResponse = WDResponse { + rspSessId :: Maybe SessionId+ , rspStatus :: Word8+ , rspVal :: Value+ }+ deriving (Eq, Show)++instance FromJSON WDResponse where+ parseJSON (Object o) = WDResponse <$> o .:? "sessionId" .!= Nothing+ <*> o .: "status"+ <*> o .:? "value" .!= Null+ parseJSON v = typeMismatch "WDResponse" v+++instance Exception InvalidURL+-- |An invalid URL was given+newtype InvalidURL = InvalidURL String+ deriving (Eq, Show, Typeable)++instance Exception HTTPStatusUnknown+-- |An unexpected HTTP status was sent by the server.+data HTTPStatusUnknown = HTTPStatusUnknown Int String+ deriving (Eq, Show, Typeable)++instance Exception HTTPConnError+-- |HTTP connection errors.+data HTTPConnError = HTTPConnError String Int+ deriving (Eq, Show, Typeable)++instance Exception UnknownCommand+-- |A command was sent to the WebDriver server that it didn't recognize.+newtype UnknownCommand = UnknownCommand String+ deriving (Eq, Show, Typeable)++instance Exception ServerError+-- |A server-side exception occured+newtype ServerError = ServerError String+ deriving (Eq, Show, Typeable)++instance Exception FailedCommand+-- |This exception encapsulates a broad variety of exceptions that can+-- occur when a command fails.+data FailedCommand = FailedCommand FailedCommandType FailedCommandInfo+ deriving (Show, Typeable)++-- |The type of failed command exception that occured.+data FailedCommandType = NoSuchElement+ | NoSuchFrame+ | UnknownFrame+ | StaleElementReference+ | ElementNotVisible+ | InvalidElementState+ | UnknownError+ | ElementIsNotSelectable+ | JavascriptError+ | XPathLookupError+ | Timeout+ | NoSuchWindow+ | InvalidCookieDomain+ | UnableToSetCookie+ | UnexpectedAlertOpen+ | NoAlertOpen+ | ScriptTimeout+ | InvalidElementCoordinates+ | IMENotAvailable+ | IMEEngineActivationFailed+ | InvalidSelector+ | SessionNotCreated+ | MoveTargetOutOfBounds+ | InvalidXPathSelector+ | InvalidXPathSelectorReturnType+ deriving (Eq, Ord, Enum, Bounded, Show)++-- |Detailed information about the failed command provided by the server.+data FailedCommandInfo =+ FailedCommandInfo { -- |The error message.+ errMsg :: String+ -- |The session associated with+ -- the exception.+ , errSess :: Maybe WDSession+ -- |A screen shot of the focused window+ -- when the exception occured,+ -- if provided.+ , errScreen :: Maybe ByteString+ -- |The "class" in which the exception+ -- was raised, if provided.+ , errClass :: Maybe String+ -- |A stack trace of the exception.+ , errStack :: [StackFrame]+ }++-- |Provides a readable printout of the error information, useful for+-- logging.+instance Show FailedCommandInfo where+ show i = showChar '\n'+ . showString "Session: " . sess+ . showChar '\n'+ . showString className . showString ": " . showString (errMsg i)+ . showChar '\n'+ . foldl (\f s-> f . showString " " . shows s) id (errStack i)+ $ ""+ where+ className = fromMaybe "<unknown exception>" . errClass $ i++ sess = case errSess i of+ Nothing -> showString "None"+ Just WDSession{..} ->+ let sessId = maybe "<no session id>" show wdSessId+ in showString sessId . showString " at "+ . shows wdSessHost . showChar ':' . shows wdSessPort+++-- |Constructs a FailedCommandInfo from only an error message.+mkFailedCommandInfo :: (WDSessionState s) => String -> s FailedCommandInfo+mkFailedCommandInfo m = do+ sess <- getSession+ return $ FailedCommandInfo { errMsg = m + , errSess = Just sess+ , errScreen = Nothing+ , errClass = Nothing+ , errStack = [] }++-- |Convenience function to throw a 'FailedCommand' locally with no server-side+-- info present.+failedCommand :: (WDSessionState s) => FailedCommandType -> String -> s a+failedCommand t m = throwIO . FailedCommand t =<< mkFailedCommandInfo m++-- |An individual stack frame from the stack trace provided by the server+-- during a FailedCommand.+data StackFrame = StackFrame { sfFileName :: String+ , sfClassName :: String+ , sfMethodName :: String+ , sfLineNumber :: Word+ }+ deriving (Eq)+++instance Show StackFrame where+ show f = showString (sfClassName f) . showChar '.'+ . showString (sfMethodName f) . showChar ' '+ . showParen True ( showString (sfFileName f) . showChar ':'+ . shows (sfLineNumber f))+ $ "\n"+++instance FromJSON FailedCommandInfo where+ parseJSON (Object o) =+ FailedCommandInfo <$> (req "message" >>= maybe (return "") return)+ <*> pure Nothing+ <*> (fmap TLE.encodeUtf8 <$> opt "screen" Nothing)+ <*> opt "class" Nothing+ <*> opt "stackTrace" []+ where req :: FromJSON a => Text -> Parser a+ req = (o .:) --required key+ opt :: FromJSON a => Text -> a -> Parser a+ opt k d = o .:? k .!= d --optional key+ parseJSON v = typeMismatch "FailedCommandInfo" v++instance FromJSON StackFrame where+ parseJSON (Object o) = StackFrame <$> reqStr "fileName"+ <*> reqStr "className"+ <*> reqStr "methodName"+ <*> req "lineNumber"+ where req :: FromJSON a => Text -> Parser a+ req = (o .:) -- all keys are required+ reqStr :: Text -> Parser String+ reqStr k = req k >>= maybe (return "") return+ parseJSON v = typeMismatch "StackFrame" v
+ src/Test/WebDriver/JSON.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE OverloadedStrings, FlexibleContexts, DeriveDataTypeable #-}+-- |A collection of convenience functions for using and parsing JSON values+-- within 'WD'. All monadic parse errors are converted to asynchronous+-- 'BadJSON' exceptions.+--+-- These functions are used internally to implement webdriver commands, and may+-- be useful for implementing non-standard commands.+module Test.WebDriver.JSON+ ( -- * Access a JSON object key+ (!:)+ -- * Conversion from JSON within WD+ -- |Apostrophes are used to disambiguate these functions+ -- from their "Data.Aeson" counterparts.+ , parseJSON', fromJSON'+ -- * Tuple functions+ -- |Convenience functions for working with tuples.++ -- ** JSON object constructors+ , single, pair, triple+ -- ** Extracting JSON objects into tuples+ , parsePair, parseTriple+ -- * Conversion from parser results to WD+ -- |These functions are used to implement the other functions+ -- in this module, and could be used to implement other JSON+ -- convenience functions+ , apResultToWD, aesonResultToWD+ -- * Parse exception+ , BadJSON(..)+ -- * "no return value" type+ , NoReturn(..)+ ) where++import Data.Aeson as Aeson+import Data.Aeson.Types+import Data.Text (Text)+import Data.ByteString.Lazy.Char8 (ByteString)+import Data.Attoparsec.ByteString.Lazy (Result(..))+import qualified Data.Attoparsec.ByteString.Lazy as AP+import qualified Data.HashMap.Strict as HM++import Control.Applicative+import Control.Monad.Trans.Control+import Control.Exception.Lifted+import Data.String+import Data.Typeable++instance Exception BadJSON+-- |An error occured when parsing a JSON value.+newtype BadJSON = BadJSON String+ deriving (Eq, Show, Typeable)+++-- |A type indicating that we expect no return value from the webdriver request.+-- Its FromJSON instance parses successfully for any values that indicate lack of+-- a return value (a notion that varies from server to server).+data NoReturn = NoReturn++instance FromJSON NoReturn where+ parseJSON Null = return NoReturn+ parseJSON (Object o) | HM.null o = return NoReturn+ parseJSON other = typeMismatch "no return value" other+++-- |Construct a singleton JSON 'object' from a key and value.+single :: ToJSON a => Text -> a -> Value+single a x = object [a .= x]++-- |Construct a 2-element JSON 'object' from a pair of keys and a pair of+-- values.+pair :: (ToJSON a, ToJSON b) => (Text,Text) -> (a,b) -> Value+pair (a,b) (x,y) = object [a .= x, b .= y]++-- |Construct a 3-element JSON 'object' from a triple of keys and a triple of+-- values.+triple :: (ToJSON a, ToJSON b, ToJSON c) =>+ (Text,Text,Text) -> (a,b,c) -> Value+triple (a,b,c) (x,y,z) = object [a .= x, b.= y, c .= z]+++-- |Parse a lazy 'ByteString' as a top-level JSON 'Value', then convert it to an+-- instance of 'FromJSON'..+parseJSON' :: MonadBaseControl IO wd => FromJSON a => ByteString -> wd a+parseJSON' = apResultToWD . AP.parse json++-- |Convert a JSON 'Value' to an instance of 'FromJSON'.+fromJSON' :: MonadBaseControl IO wd => FromJSON a => Value -> wd a+fromJSON' = aesonResultToWD . fromJSON++-- |This operator is a wrapper over Aeson's '.:' operator.+(!:) :: (MonadBaseControl IO wd, FromJSON a) => Object -> Text -> wd a+o !: k = aesonResultToWD $ parse (.: k) o+++-- |Parse a JSON 'Object' as a pair. The first two string arguments specify the+-- keys to extract from the object. The third string is the name of the+-- calling function, for better error reporting.+parsePair :: (MonadBaseControl IO wd, FromJSON a, FromJSON b) =>+ String -> String -> String -> Value -> wd (a, b)+parsePair a b funcName v =+ case v of+ Object o -> (,) <$> o !: fromString a <*> o !: fromString b+ _ -> throwIO . BadJSON $ funcName +++ ": cannot parse non-object JSON response as a (" ++ a+ ++ ", " ++ b ++ ") pair" ++ ")"+++-- |Parse a JSON Object as a triple. The first three string arguments+-- specify the keys to extract from the object. The fourth string is the name+-- of the calling function, for better error reporting.+parseTriple :: (MonadBaseControl IO wd, FromJSON a, FromJSON b, FromJSON c) =>+ String -> String -> String -> String -> Value -> wd (a, b, c)+parseTriple a b c funcName v =+ case v of+ Object o -> (,,) <$> o !: fromString a+ <*> o !: fromString b+ <*> o !: fromString c+ _ -> throwIO . BadJSON $ funcName +++ ": cannot parse non-object JSON response as a (" ++ a+ ++ ", " ++ b ++ ", " ++ c ++ ") pair"++++-- |Convert an attoparsec parser result to 'WD'.+apResultToWD :: (MonadBaseControl IO wd, FromJSON a) => AP.Result Value -> wd a+apResultToWD p = case p of+ Done _ res -> fromJSON' res+ Fail _ _ err -> throwIO $ BadJSON err++-- |Convert an Aeson parser result to 'WD'.+aesonResultToWD :: (MonadBaseControl IO wd) => Aeson.Result a -> wd a+aesonResultToWD r = case r of+ Success val -> return val+ Error err -> throwIO $ BadJSON err
+ src/Test/WebDriver/Monad.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE FlexibleContexts, TypeFamilies, GeneralizedNewtypeDeriving,+ MultiParamTypeClasses #-}+module Test.WebDriver.Monad+ ( WD(..), runWD, runSession, withSession, finallyClose, closeOnException, dumpSessionHistory+ ) where++import Test.WebDriver.Class+import Test.WebDriver.Session+import Test.WebDriver.Config+import Test.WebDriver.Commands+import Test.WebDriver.Internal++import Control.Monad.Base (MonadBase, liftBase)+import Control.Monad.Reader+import Control.Monad.Trans.Control (MonadBaseControl(..), StM)+import Control.Monad.State.Strict (StateT, MonadState, evalStateT, get, put)+--import Control.Monad.IO.Class (MonadIO)+import Control.Exception.Lifted+import Control.Monad.Catch (MonadThrow, MonadCatch)+import Control.Applicative+++{- |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, MonadThrow, MonadCatch)++instance MonadBase IO WD where+ liftBase = WD . liftBase++instance MonadBaseControl IO WD where+ data StM WD a = StWD {unStWD :: StM (StateT WDSession IO) a}++ liftBaseWith f = WD $+ liftBaseWith $ \runInBase ->+ f (\(WD sT) -> liftM StWD . runInBase $ sT)++ restoreM = WD . restoreM . unStWD++instance WDSessionState WD where+ getSession = WD get+ putSession = WD . put++instance WebDriver WD where+ doCommand method path args =+ mkRequest [] method path args+ >>= sendHTTPRequest+ >>= getJSONResult+ >>= either throwIO return+++-- |Executes a 'WD' computation within the 'IO' monad, using the given+-- 'WDSession'.+runWD :: WDSession -> WD a -> IO a+runWD sess (WD wd) = evalStateT wd sess++-- |Executes a 'WD' computation within the 'IO' monad, automatically creating a new session beforehand.+--+-- NOTE: session is not automatically closed. If you want this behavior, use 'finallyClose'.+runSession :: WDConfig -> WD a -> IO a+runSession conf wd = do+ sess <- mkSession conf+ runWD sess $ createSession (wdCapabilities conf) >> wd++-- |Locally sets a 'WDSession' for use within the given 'WD' action.+-- The state of the outer action is unaffected by this function.+-- This function is useful if you need to work with multiple sessions at once.+withSession :: WDSession -> WD a -> WD a+withSession s' (WD wd) = WD . lift $ evalStateT wd s'++-- |A finalizer ensuring that the session is always closed at the end of+-- the given 'WD' action, regardless of any exceptions.+finallyClose:: WebDriver wd => wd a -> wd a+finallyClose wd = closeOnException wd <* closeSession++-- |Exception handler that closes the session when an+-- asynchronous exception is thrown, but otherwise leaves the session open+-- if the action was successful.+closeOnException :: WebDriver wd => wd a -> wd a+closeOnException wd = wd `onException` closeSession++-- |Prints a history of API requests to stdout after computing the given action.+dumpSessionHistory :: (MonadIO wd, WebDriver wd) => wd a -> wd a+dumpSessionHistory wd = do+ v <- wd+ getSession >>= liftIO . print . wdSessHist+ return v
+ src/Test/WebDriver/Session.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, FlexibleContexts,+ GeneralizedNewtypeDeriving, RecordWildCards #-}+module Test.WebDriver.Session(+ -- * WDSessionState class+ WDSessionState(..), modifySession+ -- ** WebDriver sessions+ , WDSession(..), lastHTTPRequest, SessionId(..)+ ) where++import Data.Aeson+import Data.ByteString as BS(ByteString) +import Data.ByteString.Lazy as LBS(ByteString)+import Data.Text (Text)+import Data.Maybe++import Control.Monad.Trans.Control+import Control.Monad.Trans.Maybe+import Control.Monad.Trans.Identity+import Control.Monad.List+import Control.Monad.Reader+import Control.Monad.Error+--import Control.Monad.Cont+import Control.Monad.Writer.Strict as SW+import Control.Monad.Writer.Lazy as LW+import Control.Monad.State.Strict as SS+import Control.Monad.State.Lazy as LS+import Control.Monad.RWS.Strict as SRWS+import Control.Monad.RWS.Lazy as LRWS++import Network.HTTP.Client (Manager, Request, Response)++{- |An opaque identifier for a WebDriver session. These handles are produced by+the server on session creation, and act to identify a session in progress. -}+newtype SessionId = SessionId Text+ deriving (Eq, Ord, Show, Read, FromJSON, ToJSON)++{- |The local state of a WebDriver session. This structure is passed+implicitly through all 'WD' computations -}+data WDSession = WDSession {+ -- server hostname+ wdSessHost :: BS.ByteString+ -- server port+ , wdSessPort :: Int+ -- Base path for API requests+ , wdSessBasePath :: BS.ByteString+ -- |An opaque reference identifying the session to+ -- use with 'WD' commands.+ -- A value of Nothing indicates that a session+ -- hasn't been created yet.+ -- Sessions can be created within 'WD' via+ -- 'Test.WebDriver.createSession', or created+ -- automatically with 'Test.WebDriver.runSession'+ , wdSessId :: Maybe SessionId+ -- |The complete history of HTTP requests and+ -- responses, most recent first.+ , wdSessHist :: [(Request, Response LBS.ByteString)]+ -- |Update function used to append new entries to session history+ , wdSessHistUpdate :: (Request, Response LBS.ByteString)+ -> [(Request, Response LBS.ByteString)]+ -> [(Request, Response LBS.ByteString)]+ -- |HTTP 'Manager' used for connection pooling by the http-client library.+ , wdSessHTTPManager :: Manager+ }+ +-- |The last HTTP request issued by this session, if any.+lastHTTPRequest :: WDSession -> Maybe Request+lastHTTPRequest = fmap fst . listToMaybe . wdSessHist+++-- |A class for monads that carry a WebDriver session with them. The+-- MonadBaseControl superclass is used for exception handling through+-- the lifted-base package.+class MonadBaseControl IO s => WDSessionState s where+ getSession :: s WDSession+ putSession :: WDSession -> s ()++modifySession :: WDSessionState s => (WDSession -> WDSession) -> s ()+modifySession f = getSession >>= putSession . f+ +instance WDSessionState m => WDSessionState (LS.StateT s m) where+ getSession = lift getSession+ putSession = lift . putSession+ +instance WDSessionState m => WDSessionState (SS.StateT s m) where+ getSession = lift getSession+ putSession = lift . putSession+ +instance WDSessionState m => WDSessionState (MaybeT m) where+ getSession = lift getSession+ putSession = lift . putSession++instance WDSessionState m => WDSessionState (IdentityT m) where+ getSession = lift getSession+ putSession = lift . putSession+ +instance (Monoid w, WDSessionState m) => WDSessionState (LW.WriterT w m) where+ getSession = lift getSession+ putSession = lift . putSession+ +instance WDSessionState m => WDSessionState (ReaderT r m) where+ getSession = lift getSession+ putSession = lift . putSession+ +instance (Error e, WDSessionState m) => WDSessionState (ErrorT e m) where+ getSession = lift getSession+ putSession = lift . putSession+ +instance (Monoid w, WDSessionState m) => WDSessionState (SRWS.RWST r w s m) where+ getSession = lift getSession+ putSession = lift . putSession+ +instance (Monoid w, WDSessionState wd) => WDSessionState (LRWS.RWST r w s wd) where+ getSession = lift getSession+ putSession = lift . putSession+
+ src/Test/WebDriver/Types.hs view
@@ -0,0 +1,41 @@+{-# OPTIONS_HADDOCK not-home #-}+module Test.WebDriver.Types+ ( -- * WebDriver sessions+ WD(..), WDSession(..), SessionId(..)+ -- * WebDriver configuration+ , WDConfig(..), defaultConfig+ -- * Capabilities+ , Capabilities(..), defaultCaps, allCaps+ , Platform(..), ProxyType(..), UnexpectedAlertBehavior(..)+ -- ** Browser-specific capabilities+ , Browser(..),+ -- ** Default settings for browsers+ firefox, chrome, ie, opera, iPhone, iPad, android+ , LogLevel(..), IELogLevel(..), IEElementScrollBehavior(..)+ -- * WebDriver objects and command-specific types+ , Element(..)+ , WindowHandle(..), currentWindow+ , Selector(..)+ , JSArg(..)+ , FrameSelector(..)+ , Cookie(..), mkCookie+ , Orientation(..)+ , MouseButton(..)+ , WebStorageType(..)+ , LogType, LogEntry(..)+ , ApplicationCacheStatus(..)+ -- * Exceptions+ , InvalidURL(..), NoSessionId(..), BadJSON(..)+ , HTTPStatusUnknown(..), HTTPConnError(..)+ , UnknownCommand(..), ServerError(..)+ , FailedCommand(..), FailedCommandType(..)+ , FailedCommandInfo(..), StackFrame(..)+ , mkFailedCommandInfo, failedCommand+ ) where++import Test.WebDriver.Monad+import Test.WebDriver.Session+import Test.WebDriver.Config+import Test.WebDriver.Commands+import Test.WebDriver.Exceptions+import Test.WebDriver.Capabilities
+ src/Test/WebDriver/Utils.hs view
@@ -0,0 +1,8 @@+module Test.WebDriver.Utils where++import Data.Text (Text)+import Data.Text.Encoding as TE+import qualified Network.HTTP.Types.URI as HTTP++urlEncode :: Text -> Text+urlEncode = TE.decodeUtf8 . HTTP.urlEncode False . TE.encodeUtf8
+ 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 (ById "kw1")+ sendKeys "Cheese!" searchBox+ submit searchBox+ setImplicitWait 50+ waitUntil 2000 $ do+ title <- getTitle+ return ("cheese!" `T.isSuffixOf` title)++testCase c = void $ runSession (defaultConfig { wdCapabilities = c }) (baidu >> searchBaidu)++testSuits = mapM_ testCase [capsFF, capsChrome]++main = do+ --testCase capsChrome `seq` testCase capsFF+ --mapM_ (forkOS . testCase) [capsFF, capsChrome]+ testSuits+ print "done"
+ webdriver-snoy.cabal view
@@ -0,0 +1,87 @@+Name: webdriver-snoy+Version: 0.6.0.2+Cabal-Version: >= 1.8+License: BSD3+License-File: LICENSE+Author: Adam Curtis+Maintainer: acurtis@spsu.edu+Homepage: https://github.com/kallisti-dev/hs-webdriver+Category: Web, Browser, Testing+Synopsis: a Haskell client for the Selenium WebDriver protocol+Build-type: Simple+Extra-source-files: README.md, TODO, CHANGELOG.md, .ghci+Description:+ This is a temporary release to deal with upstream dependency issues. It will be deprecated as soon as <https://github.com/kallisti-dev/hs-webdriver/issues/53> is dealt with.+ .+ A Selenium WebDriver client for Haskell.+ You can use it to automate browser sessions+ for testing, system administration, etc.+ .+ For more information about Selenium itself, see+ <http://seleniumhq.org/>+ .+ To find out what's been changed in this version and others,+ see the change log at+ <https://github.com/kallisti-dev/hs-webdriver/blob/master/CHANGELOG.md>++source-repository head+ type: git+ location: git://github.com/kallisti-dev/hs-webdriver.git++library+ hs-source-dirs: src+ ghc-options: -Wall+ build-depends: base == 4.*+ , aeson >= 0.6.2.0 && < 0.9+ , network >= 2.4 && < 2.6+ , http-client >= 0.3 && < 0.4+ , http-types >= 0.8 && < 0.9+ , text >= 0.11.3 && < 1.2.0.0+ , bytestring >= 0.9 && < 0.11+ , attoparsec < 0.13+ , base64-bytestring >= 1.0 && < 1.1+ , mtl >= 2.0 && < 2.3+ , transformers >= 0.2 && < 0.5+ , monad-control == 0.3.* + , transformers-base >= 0.1 && < 1.0+ , lifted-base >= 0.1 && < 0.3+ , zip-archive >= 0.1.1.8 && < 0.3+ , directory == 1.*+ , filepath == 1.*+ , directory-tree >= 0.11 && < 0.13+ , temporary >= 1.0 && < 2.0+ , time == 1.*+ , unordered-containers >= 0.1.3 && < 0.4+ , vector >= 0.3 && < 0.11+ , exceptions >= 0.4 && < 0.7+ , scientific >= 0.2 && < 0.4+ , data-default >= 0.2 && < 1.0+ , cond >= 0.3 && < 0.5++ exposed-modules: Test.WebDriver+ Test.WebDriver.Class+ Test.WebDriver.Monad+ Test.WebDriver.Session+ Test.WebDriver.Config+ Test.WebDriver.Exceptions+ Test.WebDriver.Commands+ Test.WebDriver.Commands.Wait+ Test.WebDriver.Commands.Internal+ Test.WebDriver.Common.Profile+ Test.WebDriver.Firefox.Profile+ Test.WebDriver.Chrome.Extension+ 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