webdriver 0.8.4 → 0.8.5
raw patch · 27 files changed
+4329/−4297 lines, 27 filessetup-changed
Files
- .ghci +1/−1
- CHANGELOG.md +372/−366
- LICENSE +24/−24
- README.md +92/−90
- Setup.hs +1/−1
- TODO.md +18/−18
- src/Test/WebDriver.hs +41/−41
- src/Test/WebDriver/Capabilities.hs +762/−742
- src/Test/WebDriver/Chrome/Extension.hs +28/−28
- src/Test/WebDriver/Class.hs +86/−86
- src/Test/WebDriver/Commands.hs +824/−824
- src/Test/WebDriver/Commands/Internal.hs +97/−97
- src/Test/WebDriver/Commands/Wait.hs +150/−150
- src/Test/WebDriver/Common/Keys.hs +200/−200
- src/Test/WebDriver/Common/Profile.hs +262/−260
- src/Test/WebDriver/Config.hs +96/−96
- src/Test/WebDriver/Exceptions.hs +10/−10
- src/Test/WebDriver/Exceptions/Internal.hs +181/−181
- src/Test/WebDriver/Firefox/Profile.hs +241/−241
- src/Test/WebDriver/Internal.hs +227/−224
- src/Test/WebDriver/JSON.hs +151/−151
- src/Test/WebDriver/Monad.hs +99/−99
- src/Test/WebDriver/Session.hs +211/−211
- src/Test/WebDriver/Session/History.hs +13/−13
- src/Test/WebDriver/Types.hs +41/−41
- src/Test/WebDriver/Utils.hs +7/−7
- webdriver.cabal +94/−95
.ghci view
@@ -1,2 +1,2 @@-:set -XOverloadedStrings -XScopedTypeVariables +:set -XOverloadedStrings -XScopedTypeVariables :m Test.WebDriver Data.Default.Class
CHANGELOG.md view
@@ -1,366 +1,372 @@-#Change Log -##0.8.4 -* Added a new `Test.WebDriver.Common.Keys` module with named constants for use with `sendKeys` -* Updated old URLs in documentation -* Introduced support for http-client 5.0 - -##0.8.3 -* Removed most upper bounds on dependencies in our cabal file to avoid stackage version madness. - -##0.8.2 -* Added a `saveScreenshot` command, for conenience, which writes the results of the `screenshot` command directly to a given file path. -* Added new `WebDriver` instance for `ExceptT`. - -##0.8.1 -* Previously internal convenience functions `noReturn` and `ignoreReturn` are now exported in Test.WebDriver.JSON -* `elemInfo` is now deprecated due to it being phased out in the Marionette (Firefox) driver. It will likely be removed once Selenium 4 is released. -* Fixed an issue causing PAC settings to not work. - -##0.8.0.4 -* Quick fix to parse "unsupported command" errors when using Marionette driver (Selenium + Marionette has nonstandard behavior when reporting that error type) - -##0.8.0.3 -* Fixed build errors for GHC < 7.10. webdriver now builds with GHC stable releases 7.4.2, 7.6.3, and 7.8.4 -* Fixed support for bytestring 0.9.* - -##0.8.0.2 -* Fixed issue introduced in 0.8 that caused build failure when using aeson < 0.10 - -##0.8.0.1 -* findElems and and findElemsFrom were accidentally changed to return a single Element in the last release. This has been fixed. - -##0.8 - -###Command changes -* All commands that previously accepted a list parameter now accepts any instance of `Foldable` instead. - - - -###Overloadable configuration -It is now possible to define custom configuration types that can be used to initialize webdriver sessions. - -`runSession` now has the following type: -```hs - runSession :: WebDriverConfig conf => conf -> WD a -> IO a -``` -And the typeclass to create new config types looks like this: - -```hs - -- |Class of types that can configure a WebDriver session. - class WebDriverConfig c where - -- |Produces a 'Capabilities' from the given configuration. - mkCaps :: MonadBase IO m => c -> m Capabilities - - -- |Produces a 'WDSession' from the given configuration. - mkSession :: MonadBase IO m => c -> m WDSession -``` - -Of course you can still use `WDConfig`, as it is now an instance of `WebDriverConfig`. - -###Reworked custom HTTP headers interface -* Support for custom request headers was added rather hastily, resulting in several functions having explicit `RequestHeaders` parameters. The interface has been reworked now so that custom request headers are stored inside `WDSession` and explicit `RequestHeaders` parameters have been removed. -* There's also now a distinction in configuration between `wdAuthHeaders` which are used only during initial session creation, and `wdRequestHeaders`, which are used with all other HTTP requests -* Two new utility functions were added to make working with custom HTTP headers easier: `withRequestHeaders` and `withAuthHeaders` - -###Clean-up and dependency changes -* Removed a whole mess of unusued import and deprecation warnings when building with GHC 7.10 -* We now enforce an attoparsec lower bound of 0.10 (there was no lower bound before) -* The unnecessary dependency on mtl is now removed. -* Added some monad transformer instances for WebDriver and WDSessionState that were mysteriously missing: strict WriterT, ReaderT, ListT -* data-default dependency was changed to data-default-class - -##0.7 - -Because this is a fairly major update, changes have been described in detail and organized into categories. Most of the potentially breaking changes are to the "intermediate" API that might affect library code or advanced applications; changes that are not entirely "user-facing" but also not quite "internal". - -Basic web test code only has to contend with a few additional symbol exports, overloading of type signatures on some existing functions, and the reworked session history API. - -###Top-level API (exposed by`Test.WebDriver` module) - * `withSession` is now overloaded over the new constraint alias `WDSessionStateControl` ([see below](#typeclass-api)). This means that it can be used with monad transformer stacks over `WD` without any lifting required. - * Added several new `WDConfig` convenience functions: `modifyCaps`, `useBrowser`, `useVersion`, `usePlatform`, `useProxy`; these functions are overloaded over the new `HasCapabilities` constraint alias ([see below](#typeclass-api)) - * Reworked and improved session history API - * Added a `SessionHistory` record type to replace the old `(Request, Response ByteString)` type. The new type has the same data as the previous tuple, but additionally records the number of attempted HTTP retries, and instead of `Response ByteString` uses `Either SomeException (Response ByteString)` so that HTTP request errors can be logged. - * Removed `wdKeepSessHist` field from `WDConfig` and replaced it with `wdHistoryConfig`, which uses a new `SessionHistoryConfig` type. - - ```hs - -- |A function used to append new requests/responses to session history. - type SessionHistoryConfig = SessionHistory -> [SessionHistory] -> [SessionHistory] - ``` - * The new field can be configured using several new constants: `noHistory`, `onlyMostRecentHistory`, and `unlimitedHistory`. Note: `unlimitedHistory` is now the default configuration for history. For the old behavior, use `onlyMostRecentHistory`. - * New top-level functions for accessing session history - - ```hs - -- |Gets the command history for the current session. - getSessionHistory :: WDSessionState wd => wd [SessionHistory] - - -- |Prints a history of API requests to stdout after computing the given action - -- or after an exception is thrown - dumpSessionHistory :: WDSessionStateControl wd => wd a -> wd a - ``` - -###Implicit waits API (`Test.WebDriver.Commands.Wait`) -* Added functions for checking some expected conditions in explicit waits: `expectNotStale`, `expectAlertOpen`, `catchFailedCommand` - -###Typeclass API -* `WDSessionState` is now a superclass of `Monad` and `Applicative` instead of `MonadBaseControl IO`. This makes the class significantly more flexible in how it can be used, as it no longer requires `IO` as a base monad. - * For convenience the following constraint aliases were added (requires `ConstraintKinds` extension to use). Several existing API functions have been updated to use these new constraints where appropriate. - - ```hs - type WDSessionStateIO s = (WDSessionState s, MonadBase IO s) - type WDSessionStateControl s = (WDSessionState s, MonadBaseControl IO s) - ``` - - * The `WDSessionStateControl` constraint is equivalent to the previous `WDSessionState` constraint. - * The `WebDriver` class is unaffected (it is now a superclass of `WDSessionStateControl`), so code using the basic `Test.WebDriver` API will not be affected. - -* New typeclasses added to `Test.WebDriver.Capabilities`: `GetCapabilities` and `SetCapabilities`; for convenience a constraint alias `HasCapabilities` has been added to work with both of these classes (requires `ConstraintKinds` extension to use) - - ```hs - -- |A typeclass for readable 'Capabilities' - class GetCapabilities t where - getCaps :: t -> Capabilities - - -- |A typeclass for writable 'Capabilities' - class SetCapabilities t where - setCaps :: Capabilities -> t -> t - - -- |Read/write 'Capabilities' - type HasCapabilities t = (GetCapabilities t, SetCapabilities t) - ``` - -###Minor API changes (not exposed to `Test.WebDriver` module) -* `Test.WebDriver.Session` changes - * new function `mostRecentHistory` added - * `lastHTTPRequest` renamed to `mostRecentHTTPRequest` (for consistency) - * `mkSession` moved from `Test.WebDriver.Config` to `Test.WebDriver.Session` -* `Test.WebDriver.Internal` changes - * `sendHTTPRequest` now returns `(Either SomeException (Response ByteString))` and catches any exceptions that occur during the request. When using default configuration, the exceptions are also saved in 'wdSessHist'. - * `Test.WebDriver.Internal` no longer defines and exports exception types. All exception defined here previously have been moved to an unexposed `Test.WebDriver.Exceptions.Internal` module. These types are still exported in the usual places. - -###Dependencies -* Now supports http-types up to 0.9 - -##0.6.3.1 -* Fixed an issue with aeson 0.10 support - -##0.6.3 -* Support aeson 0.10 -* Added support for multiple HTTP attempts per command request, using the new WDConfig field wdHTTPRetryCount - -##0.6.2.1 -* Supports vector 0.11, aeson 0.9, attoparsec 0.13 - -##0.6.2 -* Supports GHC 7.10 -* Supports reworked Chrome capabilities used by newer versions of WebDriver -* Servers that return empty JSON strings for commands with no return value will no longer cause parse errors - -##0.6.1 -* Added the ability to pass HTTP request headers at session creation -* Fixed an issue involving an obsolete JSON representation of Chrome capabilities -* Relax upper bound on exceptions dependency - -##0.6.0.4 -* Support for monad-control 1.0 - -##0.6.0.3 -* Relaxed upper bounds on text and http-client versions - -##0.6.0.2 -* Added support for aeson > 0.8 and network > 2.6 -* Added support for the "X-Response-Body-Start" HTTP header used for error responses in newer http-client versions - -##0.6.0.1 -* Fixed Haddock parse errors. No code changes introduced in this version. - -##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 +#Change Log+##0.8.5+* Added support for experimental Chrome options that are not part of the API+* Added a Phantomjs constructor for the Browser type+* Changed the type of StackFrame line numbers from Word to Int to avoid parse errors in newer Aeson versions (sometimes the server returns negative line numbers)+* Fixed support for http-client > 0.5++##0.8.4+* Added a new `Test.WebDriver.Common.Keys` module with named constants for use with `sendKeys`+* Updated old URLs in documentation+* Introduced support for http-client 5.0++##0.8.3+* Removed most upper bounds on dependencies in our cabal file to avoid stackage version madness.++##0.8.2+* Added a `saveScreenshot` command, for conenience, which writes the results of the `screenshot` command directly to a given file path.+* Added new `WebDriver` instance for `ExceptT`.++##0.8.1+* Previously internal convenience functions `noReturn` and `ignoreReturn` are now exported in Test.WebDriver.JSON+* `elemInfo` is now deprecated due to it being phased out in the Marionette (Firefox) driver. It will likely be removed once Selenium 4 is released.+* Fixed an issue causing PAC settings to not work. ++##0.8.0.4+* Quick fix to parse "unsupported command" errors when using Marionette driver (Selenium + Marionette has nonstandard behavior when reporting that error type)++##0.8.0.3+* Fixed build errors for GHC < 7.10. webdriver now builds with GHC stable releases 7.4.2, 7.6.3, and 7.8.4+* Fixed support for bytestring 0.9.*++##0.8.0.2+* Fixed issue introduced in 0.8 that caused build failure when using aeson < 0.10++##0.8.0.1+* findElems and and findElemsFrom were accidentally changed to return a single Element in the last release. This has been fixed. ++##0.8++###Command changes+* All commands that previously accepted a list parameter now accepts any instance of `Foldable` instead.++++###Overloadable configuration+It is now possible to define custom configuration types that can be used to initialize webdriver sessions.++`runSession` now has the following type:+```hs+ runSession :: WebDriverConfig conf => conf -> WD a -> IO a+```+And the typeclass to create new config types looks like this:++```hs+ -- |Class of types that can configure a WebDriver session.+ class WebDriverConfig c where+ -- |Produces a 'Capabilities' from the given configuration.+ mkCaps :: MonadBase IO m => c -> m Capabilities++ -- |Produces a 'WDSession' from the given configuration.+ mkSession :: MonadBase IO m => c -> m WDSession+```++Of course you can still use `WDConfig`, as it is now an instance of `WebDriverConfig`.++###Reworked custom HTTP headers interface+* Support for custom request headers was added rather hastily, resulting in several functions having explicit `RequestHeaders` parameters. The interface has been reworked now so that custom request headers are stored inside `WDSession` and explicit `RequestHeaders` parameters have been removed.+* There's also now a distinction in configuration between `wdAuthHeaders` which are used only during initial session creation, and `wdRequestHeaders`, which are used with all other HTTP requests+* Two new utility functions were added to make working with custom HTTP headers easier: `withRequestHeaders` and `withAuthHeaders`++###Clean-up and dependency changes+* Removed a whole mess of unusued import and deprecation warnings when building with GHC 7.10+* We now enforce an attoparsec lower bound of 0.10 (there was no lower bound before)+* The unnecessary dependency on mtl is now removed.+* Added some monad transformer instances for WebDriver and WDSessionState that were mysteriously missing: strict WriterT, ReaderT, ListT+* data-default dependency was changed to data-default-class++##0.7++Because this is a fairly major update, changes have been described in detail and organized into categories. Most of the potentially breaking changes are to the "intermediate" API that might affect library code or advanced applications; changes that are not entirely "user-facing" but also not quite "internal".++Basic web test code only has to contend with a few additional symbol exports, overloading of type signatures on some existing functions, and the reworked session history API.++###Top-level API (exposed by`Test.WebDriver` module)+ * `withSession` is now overloaded over the new constraint alias `WDSessionStateControl` ([see below](#typeclass-api)). This means that it can be used with monad transformer stacks over `WD` without any lifting required.+ * Added several new `WDConfig` convenience functions: `modifyCaps`, `useBrowser`, `useVersion`, `usePlatform`, `useProxy`; these functions are overloaded over the new `HasCapabilities` constraint alias ([see below](#typeclass-api))+ * Reworked and improved session history API+ * Added a `SessionHistory` record type to replace the old `(Request, Response ByteString)` type. The new type has the same data as the previous tuple, but additionally records the number of attempted HTTP retries, and instead of `Response ByteString` uses `Either SomeException (Response ByteString)` so that HTTP request errors can be logged.+ * Removed `wdKeepSessHist` field from `WDConfig` and replaced it with `wdHistoryConfig`, which uses a new `SessionHistoryConfig` type.+ + ```hs+ -- |A function used to append new requests/responses to session history.+ type SessionHistoryConfig = SessionHistory -> [SessionHistory] -> [SessionHistory]+ ```+ * The new field can be configured using several new constants: `noHistory`, `onlyMostRecentHistory`, and `unlimitedHistory`. Note: `unlimitedHistory` is now the default configuration for history. For the old behavior, use `onlyMostRecentHistory`.+ * New top-level functions for accessing session history+ + ```hs+ -- |Gets the command history for the current session.+ getSessionHistory :: WDSessionState wd => wd [SessionHistory]+ + -- |Prints a history of API requests to stdout after computing the given action+ -- or after an exception is thrown+ dumpSessionHistory :: WDSessionStateControl wd => wd a -> wd a+ ```++###Implicit waits API (`Test.WebDriver.Commands.Wait`)+* Added functions for checking some expected conditions in explicit waits: `expectNotStale`, `expectAlertOpen`, `catchFailedCommand`++###Typeclass API+* `WDSessionState` is now a superclass of `Monad` and `Applicative` instead of `MonadBaseControl IO`. This makes the class significantly more flexible in how it can be used, as it no longer requires `IO` as a base monad.+ * For convenience the following constraint aliases were added (requires `ConstraintKinds` extension to use). Several existing API functions have been updated to use these new constraints where appropriate.+ + ```hs+ type WDSessionStateIO s = (WDSessionState s, MonadBase IO s)+ type WDSessionStateControl s = (WDSessionState s, MonadBaseControl IO s)+ ```+ + * The `WDSessionStateControl` constraint is equivalent to the previous `WDSessionState` constraint.+ * The `WebDriver` class is unaffected (it is now a superclass of `WDSessionStateControl`), so code using the basic `Test.WebDriver` API will not be affected.++* New typeclasses added to `Test.WebDriver.Capabilities`: `GetCapabilities` and `SetCapabilities`; for convenience a constraint alias `HasCapabilities` has been added to work with both of these classes (requires `ConstraintKinds` extension to use)+ + ```hs+ -- |A typeclass for readable 'Capabilities'+ class GetCapabilities t where+ getCaps :: t -> Capabilities+ + -- |A typeclass for writable 'Capabilities'+ class SetCapabilities t where+ setCaps :: Capabilities -> t -> t+ + -- |Read/write 'Capabilities'+ type HasCapabilities t = (GetCapabilities t, SetCapabilities t)+ ```+ +###Minor API changes (not exposed to `Test.WebDriver` module)+* `Test.WebDriver.Session` changes+ * new function `mostRecentHistory` added+ * `lastHTTPRequest` renamed to `mostRecentHTTPRequest` (for consistency)+ * `mkSession` moved from `Test.WebDriver.Config` to `Test.WebDriver.Session`+* `Test.WebDriver.Internal` changes+ * `sendHTTPRequest` now returns `(Either SomeException (Response ByteString))` and catches any exceptions that occur during the request. When using default configuration, the exceptions are also saved in 'wdSessHist'.+ * `Test.WebDriver.Internal` no longer defines and exports exception types. All exception defined here previously have been moved to an unexposed `Test.WebDriver.Exceptions.Internal` module. These types are still exported in the usual places.++###Dependencies+* Now supports http-types up to 0.9++##0.6.3.1+* Fixed an issue with aeson 0.10 support++##0.6.3+* Support aeson 0.10+* Added support for multiple HTTP attempts per command request, using the new WDConfig field wdHTTPRetryCount++##0.6.2.1+* Supports vector 0.11, aeson 0.9, attoparsec 0.13++##0.6.2+* Supports GHC 7.10+* Supports reworked Chrome capabilities used by newer versions of WebDriver+* Servers that return empty JSON strings for commands with no return value will no longer cause parse errors ++##0.6.1+* Added the ability to pass HTTP request headers at session creation+* Fixed an issue involving an obsolete JSON representation of Chrome capabilities+* Relax upper bound on exceptions dependency++##0.6.0.4+* Support for monad-control 1.0++##0.6.0.3+* Relaxed upper bounds on text and http-client versions ++##0.6.0.2+* Added support for aeson > 0.8 and network > 2.6+* Added support for the "X-Response-Body-Start" HTTP header used for error responses in newer http-client versions++##0.6.0.1+* Fixed Haddock parse errors. No code changes introduced in this version.++##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
@@ -1,25 +1,25 @@-Copyright (c) 2012-2015, 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 +Copyright (c) 2012-2015, 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
@@ -1,90 +1,92 @@-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/ - -# Contents -* [Installation](#installation) - * [Installation from Hackage](#installation-from-hackage) - * [Installation from This Repository](#installation-from-this-repository) -* [Getting Started](#getting-started) - * [Using the Selenium Server](#using-the-selenium-server) - * [Hello, World!](#hello-world) - * [Demonic invocations: a bit of boilerplate](#demonic-invocations-a-bit-of-boilerplate) - * [Configuring a WebDriver session](#configuring-a-webdriver-session) - * [Initializing tests](#initializing-tests) - * [Actually writing tests!](#actually-writing-tests) -* [Integration with Haskell Testing Frameworks](#integration-with-haskell-testing-frameworks) -* [Documentation](#documentation) - -# 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, you must have a WebDriver server to which you can connect in order to make use of this library. - -##Using the Selenium Server -While you can use any WebDriver server out there, probably the simplest server to use with hs-webdriver is [Selenium Server](http://docs.seleniumhq.org/download/). You'll need an installation of the Java runtime to use this server. Once you've downloaded Selenium Server to your current working directory, you can start the server with this shell command: - - java -jar selenium-server-standalone-*.jar - -The server should now be listening at localhost on port 4444. - -##Hello, World! -With the Selenium server running locally, you're ready to write browser automation scripts in Haskell. - -A [simple example can be found here](/examples/readme-example-beginner.md), written in literate Haskell so that you can compile it with GHC yourself. It is very beginner friendly and assumes no prior knowledge of Haskell. If you already have an intermediate understanding of Haskell, [this is the example for you](/examples/readme-example-intermediate.md) For other examples see the [examples](examples/) and [test/etc](test/etc/) directory. - - -#Integration with Haskell Testing Frameworks - -This package does not provide utilities to integrate with popular Haskell testing frameworks. However, other packages exist for this purpose: - -* [hspec-webdriver](https://hackage.haskell.org/package/hspec-webdriver) -* [quickcheck-webdriver](https://hackage.haskell.org/package/quickcheck-webdriver) - -#Documentation - -Documentation for hs-webdriver is available on Hackage at <http://hackage.haskell.org/package/webdriver>. You can also generate local HTML documentation from this source revision with the following shell command: - -```sh -runhaskell Setup.hs haddock -``` - -Haddock will generate documentation and save it in `dist/doc/html/webdriver` - +[](https://travis-ci.org/kallisti-dev/hs-webdriver)++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/++# Contents+* [Installation](#installation)+ * [Installation from Hackage](#installation-from-hackage)+ * [Installation from This Repository](#installation-from-this-repository)+* [Getting Started](#getting-started)+ * [Using the Selenium Server](#using-the-selenium-server)+ * [Hello, World!](#hello-world)+ * [Demonic invocations: a bit of boilerplate](#demonic-invocations-a-bit-of-boilerplate)+ * [Configuring a WebDriver session](#configuring-a-webdriver-session)+ * [Initializing tests](#initializing-tests)+ * [Actually writing tests!](#actually-writing-tests)+* [Integration with Haskell Testing Frameworks](#integration-with-haskell-testing-frameworks)+* [Documentation](#documentation)++# 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, you must have a WebDriver server to which you can connect in order to make use of this library.++## Using the Selenium Server+While you can use any WebDriver server out there, probably the simplest server to use with hs-webdriver is [Selenium Server](http://docs.seleniumhq.org/download/). You'll need an installation of the Java runtime to use this server. Once you've downloaded Selenium Server to your current working directory, you can start the server with this shell command:++ java -jar selenium-server-standalone-*.jar++The server should now be listening at localhost on port 4444.++## Hello, World!+With the Selenium server running locally, you're ready to write browser automation scripts in Haskell.++A [simple example can be found here](/examples/readme-example-beginner.md), written in literate Haskell so that you can compile it with GHC yourself. It is very beginner friendly and assumes no prior knowledge of Haskell. If you already have an intermediate understanding of Haskell, [this is the example for you](/examples/readme-example-intermediate.md) For other examples see the [examples](examples/) and [test/etc](test/etc/) directory.+++# Integration with Haskell Testing Frameworks++This package does not provide utilities to integrate with popular Haskell testing frameworks. However, other packages exist for this purpose:++* [hspec-webdriver](https://hackage.haskell.org/package/hspec-webdriver)+* [quickcheck-webdriver](https://hackage.haskell.org/package/quickcheck-webdriver)++# Documentation++Documentation for hs-webdriver is available on Hackage at <http://hackage.haskell.org/package/webdriver>. You can also generate local HTML documentation from this source revision with the following shell command:++```sh+runhaskell Setup.hs haddock+```++Haddock will generate documentation and save it in `dist/doc/html/webdriver`+
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple +import Distribution.Simple main = defaultMain
TODO.md view
@@ -1,18 +1,18 @@-#known issues -- fix loadProfile so that it doesn't cause an overlap with user addExtension calls - -#features -- support new w3c webdriver spec: http://www.w3.org/TR/webdriver/ - - try to support backwards compatibility with old wire protocol, otherwise provide legacy API in submodule (?) - - mock-up example of actions API: http://lpaste.net/3484676197546196992 -- allow WDConfig to automatically load drivers. add modules with driver loading functions -- overload URL inputs/outputs to implicitly support structured URL types -- add support for Opera profiles -- POST "/session/{sessionId}/phantom/execute" - -#documentation -- document errors. - - -#considerations -- 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. +#known issues+- fix loadProfile so that it doesn't cause an overlap with user addExtension calls++#features+- support new w3c webdriver spec: http://www.w3.org/TR/webdriver/+ - try to support backwards compatibility with old wire protocol, otherwise provide legacy API in submodule (?) + - mock-up example of actions API: http://lpaste.net/3484676197546196992+- allow WDConfig to automatically load drivers. add modules with driver loading functions+- overload URL inputs/outputs to implicitly support structured URL types+- add support for Opera profiles+- POST "/session/{sessionId}/phantom/execute"++#documentation+- document errors.+++#considerations+- 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
@@ -1,41 +1,41 @@-{-| -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 monad - WD(..) - -- * Running WebDriver commands - , runSession, withSession, runWD - -- * WebDriver configuration - , WDConfig(..), defaultConfig - -- ** Configuration helper functions - -- | Instead of working with the 'Capabilities' record directly, you can use - -- these config modifier functions to specify common options. - , useBrowser, useProxy, useVersion, usePlatform - -- ** Session history configuration - , SessionHistoryConfig, noHistory, unlimitedHistory, onlyMostRecentHistory - -- ** HTTP request header utilities - , withRequestHeaders, withAuthHeaders - -- * WebDriver commands - , module Test.WebDriver.Commands - -- * Capabilities (advanced configuration) - , Capabilities(..), defaultCaps, allCaps, modifyCaps - , Platform(..), ProxyType(..) - -- ** Browser-specific capabilities - , Browser(..), LogLevel(..) - -- *** Browser defaults - , firefox, chrome, ie, opera, iPhone, iPad, android - -- * Exception handling - , finallyClose, closeOnException - , module Test.WebDriver.Exceptions - -- * Accessing session history - , SessionHistory(..), getSessionHistory, dumpSessionHistory - ) where - -import Test.WebDriver.Types -import Test.WebDriver.Commands -import Test.WebDriver.Monad -import Test.WebDriver.Exceptions -import Test.WebDriver.Config -import Test.WebDriver.Session +{-|+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 monad+ WD(..) + -- * Running WebDriver commands+ , runSession, withSession, runWD+ -- * WebDriver configuration+ , WDConfig(..), defaultConfig+ -- ** Configuration helper functions+ -- | Instead of working with the 'Capabilities' record directly, you can use + -- these config modifier functions to specify common options.+ , useBrowser, useProxy, useVersion, usePlatform + -- ** Session history configuration+ , SessionHistoryConfig, noHistory, unlimitedHistory, onlyMostRecentHistory+ -- ** HTTP request header utilities+ , withRequestHeaders, withAuthHeaders+ -- * WebDriver commands+ , module Test.WebDriver.Commands+ -- * Capabilities (advanced configuration)+ , Capabilities(..), defaultCaps, allCaps, modifyCaps+ , Platform(..), ProxyType(..)+ -- ** Browser-specific capabilities+ , Browser(..), LogLevel(..)+ -- *** Browser defaults+ , firefox, chrome, ie, opera, iPhone, iPad, android+ -- * Exception handling+ , finallyClose, closeOnException+ , module Test.WebDriver.Exceptions+ -- * Accessing session history+ , SessionHistory(..), getSessionHistory, dumpSessionHistory+ ) where++import Test.WebDriver.Types+import Test.WebDriver.Commands+import Test.WebDriver.Monad+import Test.WebDriver.Exceptions+import Test.WebDriver.Config+import Test.WebDriver.Session
src/Test/WebDriver/Capabilities.hs view
@@ -1,742 +1,762 @@-{-# LANGUAGE OverloadedStrings, RecordWildCards, ConstraintKinds - #-} -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.Class (Default(..)) -import Data.Word (Word16) -import Data.Maybe (fromMaybe, catMaybes) -import Data.String (fromString) - -import Control.Applicative -import Control.Exception.Lifted (throw) - -import Prelude -- hides some "unused import" warnings - --- |A typeclass for readable 'Capabilities' -class GetCapabilities t where - getCaps :: t -> Capabilities - -instance GetCapabilities Capabilities where - getCaps = id - --- |A typeclass for writable 'Capabilities' -class SetCapabilities t where - setCaps :: Capabilities -> t -> t - --- |Read/write 'Capabilities' -type HasCapabilities t = (GetCapabilities t, SetCapabilities t) - --- |Modifies the 'wdCapabilities' field of a 'WDConfig' by applying the given function. Overloaded to work with any 'HasCapabilities' instance. -modifyCaps :: HasCapabilities t => (Capabilities -> Capabilities) -> t -> t -modifyCaps f c = setCaps (f (getCaps c)) c - --- |A helper function for setting the 'browser' capability of a 'HasCapabilities' instance -useBrowser :: HasCapabilities t => Browser -> t -> t -useBrowser b = modifyCaps $ \c -> c { browser = b } - --- |A helper function for setting the 'version' capability of a 'HasCapabilities' instance -useVersion :: HasCapabilities t => String -> t -> t -useVersion v = modifyCaps $ \c -> c { version = Just v } - --- |A helper function for setting the 'platform' capability of a 'HasCapabilities' instance -usePlatform :: HasCapabilities t => Platform -> t -> t -usePlatform p = modifyCaps $ \c -> c { platform = p } - --- |A helper function for setting the 'useProxy' capability of a 'HasCapabilities' instance -useProxy :: HasCapabilities t => ProxyType -> t -> t -useProxy p = modifyCaps $ \c -> c { proxy = p } - - -{- |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 $ filter (\p -> snd p /= Null) - $ [ "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 ] - ++ [ "chromeOptions" .= object (catMaybes - [ opt "binary" chromeBinary - ] ++ - [ "args" .= chromeOptions - , "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 - -- <https://github.com/SeleniumHQ/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) - ,"proxyAutoconfigUrl" .= 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 - +{-# LANGUAGE OverloadedStrings, RecordWildCards, ConstraintKinds+ #-}+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, empty)++import Data.Text (Text, toLower, toUpper)+import Data.Default.Class (Default(..))+import Data.Word (Word16)+import Data.Maybe (fromMaybe, catMaybes)+import Data.String (fromString)++import Control.Applicative+import Control.Exception.Lifted (throw)++import Prelude -- hides some "unused import" warnings++-- |A typeclass for readable 'Capabilities'+class GetCapabilities t where+ getCaps :: t -> Capabilities++instance GetCapabilities Capabilities where+ getCaps = id++-- |A typeclass for writable 'Capabilities'+class SetCapabilities t where+ setCaps :: Capabilities -> t -> t++-- |Read/write 'Capabilities'+type HasCapabilities t = (GetCapabilities t, SetCapabilities t)++-- |Modifies the 'wdCapabilities' field of a 'WDConfig' by applying the given function. Overloaded to work with any 'HasCapabilities' instance.+modifyCaps :: HasCapabilities t => (Capabilities -> Capabilities) -> t -> t+modifyCaps f c = setCaps (f (getCaps c)) c++-- |A helper function for setting the 'browser' capability of a 'HasCapabilities' instance+useBrowser :: HasCapabilities t => Browser -> t -> t+useBrowser b = modifyCaps $ \c -> c { browser = b }++-- |A helper function for setting the 'version' capability of a 'HasCapabilities' instance+useVersion :: HasCapabilities t => String -> t -> t+useVersion v = modifyCaps $ \c -> c { version = Just v }++-- |A helper function for setting the 'platform' capability of a 'HasCapabilities' instance +usePlatform :: HasCapabilities t => Platform -> t -> t+usePlatform p = modifyCaps $ \c -> c { platform = p }++-- |A helper function for setting the 'useProxy' capability of a 'HasCapabilities' instance+useProxy :: HasCapabilities t => ProxyType -> t -> t+useProxy p = modifyCaps $ \c -> c { proxy = p }+++{- |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 $ filter (\p -> snd p /= Null)+ $ [ "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 ]+ ++ [ "chromeOptions" .= object (catMaybes+ [ opt "binary" chromeBinary+ ] +++ [ "args" .= chromeOptions+ , "extensions" .= chromeExtensions+ ] ++ HM.toList chromeExperimentalOptions+ )]+ 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+ ]++ Phantomjs {..}+ -> catMaybes [ opt "phantomjs.binary.path" phantomjsBinary+ ] ++ + [ "phantomjs.cli.args" .= phantomjsOptions+ ]++ _ -> []++ 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.binary" Nothing+ <*> opt "chrome.switches" []+ <*> opt "chrome.extensions" []+ <*> pure HM.empty+ 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+ -- <https://github.com/SeleniumHQ/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]+ -- | Experimental options not yet exposed through a standard API.+ , chromeExperimentalOptions :: Object+ }+ | 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+ }++ | Phantomjs { phantomjsBinary :: Maybe FilePath+ , phantomjsOptions :: [String]+ }++ | 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 Phantomjs {} = String "phantomjs"+ 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+ "phantomjs" -> return phantomjs+ -- "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 [] [] HM.empty++-- |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+ }++phantomjs :: Browser+phantomjs = Phantomjs Nothing []++--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)+ ,"proxyAutoconfigUrl" .= 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
@@ -1,29 +1,29 @@-{-# 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 - -import Prelude -- hides some "unused import" warnings - --- |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 +{-# 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++import Prelude -- hides some "unused import" warnings++-- |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
@@ -1,86 +1,86 @@-{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, FlexibleContexts, CPP, - GeneralizedNewtypeDeriving, RecordWildCards, ConstraintKinds #-} -#ifndef CABAL_BUILD_DEVELOPER -{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -#endif -module Test.WebDriver.Class - ( -- * WebDriver class - WebDriver(..), Method, methodDelete, methodGet, methodPost, - ) where -import Test.WebDriver.Session - -import Data.Aeson -import Data.Text (Text) -#if !MIN_VERSION_base(4,8,0) -import Data.Monoid (Monoid) -- for some reason "import Prelude" trick doesn't work with "import Data.Monoid" -#endif - -import Network.HTTP.Types.Method (methodDelete, methodGet, methodPost, Method) - -import Control.Monad.Trans.Class -import Control.Monad.Trans.Maybe -import Control.Monad.Trans.Identity -import Control.Monad.Trans.List -import Control.Monad.Trans.Reader -import Control.Monad.Trans.Error -import Control.Monad.Trans.Except ---import Control.Monad.Cont -import Control.Monad.Trans.Writer.Strict as SW -import Control.Monad.Trans.Writer.Lazy as LW -import Control.Monad.Trans.State.Strict as SS -import Control.Monad.Trans.State.Lazy as LS -import Control.Monad.Trans.RWS.Strict as SRWS -import Control.Monad.Trans.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 --- <https://github.com/SeleniumHQ/selenium/wiki/JsonWireProtocol> -class (WDSessionStateControl 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 WebDriver wd => WebDriver (ListT 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 (Monoid w, WebDriver wd) => WebDriver (SW.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 WebDriver wd => WebDriver (ExceptT 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) +{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, FlexibleContexts, CPP,+ GeneralizedNewtypeDeriving, RecordWildCards, ConstraintKinds #-}+#ifndef CABAL_BUILD_DEVELOPER+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}+#endif+module Test.WebDriver.Class+ ( -- * WebDriver class+ WebDriver(..), Method, methodDelete, methodGet, methodPost,+ ) where+import Test.WebDriver.Session++import Data.Aeson+import Data.Text (Text)+#if !MIN_VERSION_base(4,8,0)+import Data.Monoid (Monoid) -- for some reason "import Prelude" trick doesn't work with "import Data.Monoid"+#endif++import Network.HTTP.Types.Method (methodDelete, methodGet, methodPost, Method)++import Control.Monad.Trans.Class+import Control.Monad.Trans.Maybe+import Control.Monad.Trans.Identity+import Control.Monad.Trans.List+import Control.Monad.Trans.Reader+import Control.Monad.Trans.Error+import Control.Monad.Trans.Except+--import Control.Monad.Cont+import Control.Monad.Trans.Writer.Strict as SW+import Control.Monad.Trans.Writer.Lazy as LW+import Control.Monad.Trans.State.Strict as SS+import Control.Monad.Trans.State.Lazy as LS+import Control.Monad.Trans.RWS.Strict as SRWS+import Control.Monad.Trans.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+-- <https://github.com/SeleniumHQ/selenium/wiki/JsonWireProtocol>+class (WDSessionStateControl 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 WebDriver wd => WebDriver (ListT 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 (Monoid w, WebDriver wd) => WebDriver (SW.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 WebDriver wd => WebDriver (ExceptT 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
@@ -1,824 +1,824 @@-{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, ExistentialQuantification, - TemplateHaskell, RecordWildCards, FlexibleContexts #-} --- |This module exports basic WD actions that can be used to interact with a --- browser session. -module Test.WebDriver.Commands - ( -- * Sessions - createSession, closeSession, sessions, getActualCaps - -- * Browser interaction - -- ** Web navigation - , openPage, forward, back, refresh - -- ** Page info - , getCurrentURL, getSource, getTitle, saveScreenshot, 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.Exceptions.Internal -import Test.WebDriver.Class -import Test.WebDriver.Session -import Test.WebDriver.JSON -import Test.WebDriver.Capabilities -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, writeFile) -import Network.URI hiding (path) -- suppresses warnings -import Codec.Archive.Zip -import qualified Data.Text.Lazy.Encoding as TL - -import Control.Monad -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.Foldable as F -import qualified Data.Char as C - -import Prelude -- hides some "unused import" warnings - --- |Create a new session with the given 'Capabilities'. The returned session becomes the \"current session\" for this action. --- --- Note: if you're using 'runSession' to run your WebDriver commands, you don't need to call this explicitly. -createSession :: WebDriver wd => Capabilities -> wd WDSession -createSession caps = do - ignoreReturn . withAuthHeaders . 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 - mapM (parsePair "id" "capabilities" "sessions") objs - --- |Get the actual server-side 'Capabilities' of the current session. -getActualCaps :: WebDriver wd => wd Capabilities -getActualCaps = 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 (ms) 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 (ms) 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 (ms) 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 a sequence of 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. - -When using 'executeJS', GHC might complain about an ambiguous type in -situations where the result of the executeJS call is ignored/discard. -Consider the following example: - -@ - jsExample = do - e <- findElem (ById "foo") - executeJS [] "someAction()" - return e -@ - -Because the result of the 'executeJS' is discarded, GHC cannot resolve -which instance of the 'fromJSON' class to use when parsing the -Selenium server response. In such cases, we can use the 'ignoreReturn' -helper function located in "Test.WebDriver.JSON". 'ignoreReturn' has -no runtime effect; it simply helps the type system by expicitly providing -a `fromJSON` instance to use. - -@ - import Test.WebDriver.JSON (ignoreReturn) - jsExample = do - e <- findElem (ById "foo") - ignoreReturn $ executeJS [] "someAction()" - return e -@ --} -executeJS :: (F.Foldable f, FromJSON a, WebDriver wd) => f JSArg -> Text -> wd a -executeJS a s = fromJSON' =<< getResult - where - getResult = doSessCommand methodPost "/execute" . pair ("args", "script") $ (F.toList 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 :: (F.Foldable f, FromJSON a, WebDriver wd) => f JSArg -> Text -> wd (Maybe a) -asyncJS a s = handle timeout $ Just <$> (fromJSON' =<< getResult) - where - getResult = doSessCommand methodPost "/execute_async" . pair ("args", "script") - $ (F.toList a,s) - timeout (FailedCommand Timeout _) = return Nothing - timeout (FailedCommand ScriptTimeout _) = return Nothing - timeout err = throwIO err - --- |Save a screenshot to a particular location -saveScreenshot :: WebDriver wd => FilePath -> wd () -saveScreenshot path = screenshot >>= liftBase . LBS.writeFile path - --- |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 w = do - cw <- getCurrentWindow - focusWindow w - noReturn $ doSessCommand methodDelete "/window" Null - unless (w == cw) $ focusWindow cw - --- |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 - } - -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 -{-# DEPRECATED elemInfo "This command does not work with Marionette (Firefox) driver, and is likely to be completely removed in Selenium 4" #-} - --- |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. Named constants for special modifier keys can be found --- in "Test.WebDriver.Common.Keys" -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 'doSessCommand' to create web storage requests. -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 --- <https://github.com/SeleniumHQ/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 ) +{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, ExistentialQuantification,+ TemplateHaskell, RecordWildCards, FlexibleContexts #-}+-- |This module exports basic WD actions that can be used to interact with a+-- browser session.+module Test.WebDriver.Commands+ ( -- * Sessions+ createSession, closeSession, sessions, getActualCaps+ -- * Browser interaction+ -- ** Web navigation+ , openPage, forward, back, refresh+ -- ** Page info+ , getCurrentURL, getSource, getTitle, saveScreenshot, 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.Exceptions.Internal+import Test.WebDriver.Class+import Test.WebDriver.Session+import Test.WebDriver.JSON+import Test.WebDriver.Capabilities+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, writeFile)+import Network.URI hiding (path) -- suppresses warnings+import Codec.Archive.Zip+import qualified Data.Text.Lazy.Encoding as TL++import Control.Monad+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.Foldable as F+import qualified Data.Char as C++import Prelude -- hides some "unused import" warnings++-- |Create a new session with the given 'Capabilities'. The returned session becomes the \"current session\" for this action. +-- +-- Note: if you're using 'runSession' to run your WebDriver commands, you don't need to call this explicitly.+createSession :: WebDriver wd => Capabilities -> wd WDSession+createSession caps = do+ ignoreReturn . withAuthHeaders . 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+ mapM (parsePair "id" "capabilities" "sessions") objs++-- |Get the actual server-side 'Capabilities' of the current session.+getActualCaps :: WebDriver wd => wd Capabilities+getActualCaps = 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 (ms) 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 (ms) 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 (ms) 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 a sequence of 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.++When using 'executeJS', GHC might complain about an ambiguous type in +situations where the result of the executeJS call is ignored/discard.+Consider the following example:++@+ jsExample = do+ e <- findElem (ById "foo")+ executeJS [] "someAction()"+ return e+@++Because the result of the 'executeJS' is discarded, GHC cannot resolve+which instance of the 'fromJSON' class to use when parsing the+Selenium server response. In such cases, we can use the 'ignoreReturn'+helper function located in "Test.WebDriver.JSON". 'ignoreReturn' has +no runtime effect; it simply helps the type system by expicitly providing+a `fromJSON` instance to use.++@+ import Test.WebDriver.JSON (ignoreReturn)+ jsExample = do+ e <- findElem (ById "foo")+ ignoreReturn $ executeJS [] "someAction()"+ return e+@+-}+executeJS :: (F.Foldable f, FromJSON a, WebDriver wd) => f JSArg -> Text -> wd a+executeJS a s = fromJSON' =<< getResult+ where+ getResult = doSessCommand methodPost "/execute" . pair ("args", "script") $ (F.toList 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 :: (F.Foldable f, FromJSON a, WebDriver wd) => f JSArg -> Text -> wd (Maybe a)+asyncJS a s = handle timeout $ Just <$> (fromJSON' =<< getResult)+ where+ getResult = doSessCommand methodPost "/execute_async" . pair ("args", "script")+ $ (F.toList a,s)+ timeout (FailedCommand Timeout _) = return Nothing+ timeout (FailedCommand ScriptTimeout _) = return Nothing+ timeout err = throwIO err+ +-- |Save a screenshot to a particular location+saveScreenshot :: WebDriver wd => FilePath -> wd ()+saveScreenshot path = screenshot >>= liftBase . LBS.writeFile path++-- |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 w = do+ cw <- getCurrentWindow+ focusWindow w+ noReturn $ doSessCommand methodDelete "/window" Null+ unless (w == cw) $ focusWindow cw++-- |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+ }++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+{-# DEPRECATED elemInfo "This command does not work with Marionette (Firefox) driver, and is likely to be completely removed in Selenium 4" #-}++-- |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. Named constants for special modifier keys can be found +-- in "Test.WebDriver.Common.Keys"+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 'doSessCommand' to create web storage requests.+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+-- <https://github.com/SeleniumHQ/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
@@ -1,97 +1,97 @@-{-# 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.Class -import Control.Applicative - -import Prelude -- hides some "unused import" warnings - -{- |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 --- <https://github.com/SeleniumHQ/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 +{-# 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.Class+import Control.Applicative++import Prelude -- hides some "unused import" warnings++{- |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+-- <https://github.com/SeleniumHQ/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
@@ -1,150 +1,150 @@-{-# LANGUAGE CPP, DeriveDataTypeable, ScopedTypeVariables, FlexibleContexts, ConstraintKinds #-} -module Test.WebDriver.Commands.Wait - ( -- * Wait on expected conditions - waitUntil, waitUntil' - , waitWhile, waitWhile' - -- * Expected conditions - , ExpectFailed, expect, unexpected - , expectAny, expectAll - , expectNotStale, expectAlertOpen - , catchFailedCommand - -- ** Convenience functions - , onTimeout - ) where -import Test.WebDriver.Commands -import Test.WebDriver.Class -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 Data.Time.Clock -import Data.Typeable -import qualified Data.Foldable as F -import Data.Text (Text) - -#if !MIN_VERSION_base(4,6,0) || 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 :: (F.Foldable f, MonadBaseControl IO m) => (a -> m Bool) -> f a -> m () -expectAny p xs = expect . F.or =<< mapM p (F.toList xs) - --- |Apply a monadic predicate to every element in a list, and 'expect' that all --- succeed. -expectAll :: (F.Foldable f, MonadBaseControl IO m) => (a -> m Bool) -> f a -> m () -expectAll p xs = expect . F.and =<< mapM p (F.toList xs) - --- | 'expect' the given 'Element' to not be stale and returns it -expectNotStale :: WebDriver wd => Element -> wd Element -expectNotStale e = catchFailedCommand StaleElementReference $ do - _ <- isEnabled e -- Any command will force a staleness check - return e - --- | 'expect' an alert to be present on the page, and returns its text. -expectAlertOpen :: WebDriver wd => wd Text -expectAlertOpen = catchFailedCommand NoAlertOpen getAlertText - --- |Catches any `FailedCommand` exceptions with the given `FailedCommandType` and rethrows as 'ExpectFailed' -catchFailedCommand :: MonadBaseControl IO m => FailedCommandType -> m a -> m a -catchFailedCommand t1 m = m `catch` handler - where - handler e@(FailedCommand t2 _) - | t1 == t2 = unexpected . show $ e - handler e = throwIO e - --- |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 :: (WDSessionStateControl 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' :: (WDSessionStateControl 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 :: (WDSessionStateControl 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' :: (WDSessionStateControl 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 :: (WDSessionStateControl 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' :: (WDSessionStateIO 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 +{-# LANGUAGE CPP, DeriveDataTypeable, ScopedTypeVariables, FlexibleContexts, ConstraintKinds #-}+module Test.WebDriver.Commands.Wait+ ( -- * Wait on expected conditions+ waitUntil, waitUntil'+ , waitWhile, waitWhile'+ -- * Expected conditions+ , ExpectFailed, expect, unexpected+ , expectAny, expectAll+ , expectNotStale, expectAlertOpen+ , catchFailedCommand+ -- ** Convenience functions+ , onTimeout+ ) where+import Test.WebDriver.Commands+import Test.WebDriver.Class+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 Data.Time.Clock+import Data.Typeable+import qualified Data.Foldable as F+import Data.Text (Text)++#if !MIN_VERSION_base(4,6,0) || 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 :: (F.Foldable f, MonadBaseControl IO m) => (a -> m Bool) -> f a -> m ()+expectAny p xs = expect . F.or =<< mapM p (F.toList xs)++-- |Apply a monadic predicate to every element in a list, and 'expect' that all+-- succeed.+expectAll :: (F.Foldable f, MonadBaseControl IO m) => (a -> m Bool) -> f a -> m ()+expectAll p xs = expect . F.and =<< mapM p (F.toList xs)++-- | 'expect' the given 'Element' to not be stale and returns it+expectNotStale :: WebDriver wd => Element -> wd Element+expectNotStale e = catchFailedCommand StaleElementReference $ do+ _ <- isEnabled e -- Any command will force a staleness check+ return e++-- | 'expect' an alert to be present on the page, and returns its text.+expectAlertOpen :: WebDriver wd => wd Text+expectAlertOpen = catchFailedCommand NoAlertOpen getAlertText++-- |Catches any `FailedCommand` exceptions with the given `FailedCommandType` and rethrows as 'ExpectFailed'+catchFailedCommand :: MonadBaseControl IO m => FailedCommandType -> m a -> m a+catchFailedCommand t1 m = m `catch` handler+ where + handler e@(FailedCommand t2 _) + | t1 == t2 = unexpected . show $ e+ handler e = throwIO e++-- |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 :: (WDSessionStateControl 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' :: (WDSessionStateControl 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 :: (WDSessionStateControl 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' :: (WDSessionStateControl 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 :: (WDSessionStateControl 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' :: (WDSessionStateIO 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/Keys.hs view
@@ -1,200 +1,200 @@-{-# LANGUAGE OverloadedStrings #-} --- |This module contains named constants corresponding to the special characters recognized by 'sendKeys'. --- For more details on these special characters, consult the Selenium documentation at --- <https://github.com/SeleniumHQ/selenium/wiki/JsonWireProtocol#sessionsessionidelementidvalue> -module Test.WebDriver.Common.Keys where - -import Data.Text (Text) - -add :: Text -add = "\xe025" - -alt :: Text -alt = "\xe00a" - -arrowDown :: Text -arrowDown = "\xe015" - -arrowLeft :: Text -arrowLeft = "\xe012" - -arrowRight :: Text -arrowRight = "\xe014" - -arrowUp :: Text -arrowUp = "\xe013" - -backspace :: Text -backspace = "\xe003" - -backSpace :: Text -backSpace = "\xe003" - -cancel :: Text -cancel = "\xe001" - -clear :: Text -clear = "\xe005" - -command :: Text -command = "\xe03d" - -control :: Text -control = "\xe009" - -decimal :: Text -decimal = "\xe028" - -delete :: Text -delete = "\xe017" - -divide :: Text -divide = "\xe029" - -down :: Text -down = "\xe015" - -end :: Text -end = "\xe010" - -enter :: Text -enter = "\xe007" - -equals :: Text -equals = "\xe019" - -escape :: Text -escape = "\xe00c" - -f1 :: Text -f1 = "\xe031" - -f2 :: Text -f2 = "\xe032" - -f3 :: Text -f3 = "\xe033" - -f4 :: Text -f4 = "\xe034" - -f5 :: Text -f5 = "\xe035" - -f6 :: Text -f6 = "\xe036" - -f7 :: Text -f7 = "\xe037" - -f8 :: Text -f8 = "\xe038" - -f9 :: Text -f9 = "\xe039" - -f10 :: Text -f10 = "\xe03a" - -f11 :: Text -f11 = "\xe03b" - -f12 :: Text -f12 = "\xe03c" - -help :: Text -help = "\xe002" - -home :: Text -home = "\xe011" - -insert :: Text -insert = "\xe016" - -left :: Text -left = "\xe012" - -leftAlt :: Text -leftAlt = "\xe00a" - -leftControl :: Text -leftControl = "\xe009" - -leftShift :: Text -leftShift = "\xe008" - -meta :: Text -meta = "\xe03d" - -multiply :: Text -multiply = "\xe024" - -null :: Text -null = "\xe000" - -numpad0 :: Text -numpad0 = "\xe01a" - -numpad1 :: Text -numpad1 = "\xe01b" - -numpad2 :: Text -numpad2 = "\xe01c" - -numpad3 :: Text -numpad3 = "\xe01d" - -numpad4 :: Text -numpad4 = "\xe01e" - -numpad5 :: Text -numpad5 = "\xe01f" - -numpad6 :: Text -numpad6 = "\xe020" - -numpad7 :: Text -numpad7 = "\xe021" - -numpad8 :: Text -numpad8 = "\xe022" - -numpad9 :: Text -numpad9 = "\xe023" - -pageDown :: Text -pageDown = "\xe00f" - -pageUp :: Text -pageUp = "\xe00e" - -pause :: Text -pause = "\xe00b" - -return :: Text -return = "\xe006" - -right :: Text -right = "\xe014" - -semicolon :: Text -semicolon = "\xe018" - -separator :: Text -separator = "\xe026" - -shift :: Text -shift = "\xe008" - -space :: Text -space = "\xe00d" - -subtract :: Text -subtract = "\xe027" - -tab :: Text -tab = "\xe004" - -up :: Text -up = "\xe013" - +{-# LANGUAGE OverloadedStrings #-}+-- |This module contains named constants corresponding to the special characters recognized by 'sendKeys'.+-- For more details on these special characters, consult the Selenium documentation at +-- <https://github.com/SeleniumHQ/selenium/wiki/JsonWireProtocol#sessionsessionidelementidvalue>+module Test.WebDriver.Common.Keys where++import Data.Text (Text)++add :: Text+add = "\xe025"++alt :: Text+alt = "\xe00a"++arrowDown :: Text+arrowDown = "\xe015"++arrowLeft :: Text+arrowLeft = "\xe012"++arrowRight :: Text+arrowRight = "\xe014"++arrowUp :: Text+arrowUp = "\xe013"++backspace :: Text+backspace = "\xe003"++backSpace :: Text+backSpace = "\xe003"++cancel :: Text+cancel = "\xe001"++clear :: Text+clear = "\xe005"++command :: Text+command = "\xe03d"++control :: Text+control = "\xe009"++decimal :: Text+decimal = "\xe028"++delete :: Text+delete = "\xe017"++divide :: Text+divide = "\xe029"++down :: Text+down = "\xe015"++end :: Text+end = "\xe010"++enter :: Text+enter = "\xe007"++equals :: Text+equals = "\xe019"++escape :: Text+escape = "\xe00c"++f1 :: Text+f1 = "\xe031"++f2 :: Text+f2 = "\xe032"++f3 :: Text+f3 = "\xe033"++f4 :: Text+f4 = "\xe034"++f5 :: Text+f5 = "\xe035"++f6 :: Text+f6 = "\xe036"++f7 :: Text+f7 = "\xe037"++f8 :: Text+f8 = "\xe038"++f9 :: Text+f9 = "\xe039"++f10 :: Text+f10 = "\xe03a"++f11 :: Text+f11 = "\xe03b"++f12 :: Text+f12 = "\xe03c"++help :: Text+help = "\xe002"++home :: Text+home = "\xe011"++insert :: Text+insert = "\xe016"++left :: Text+left = "\xe012"++leftAlt :: Text+leftAlt = "\xe00a"++leftControl :: Text+leftControl = "\xe009"++leftShift :: Text+leftShift = "\xe008"++meta :: Text+meta = "\xe03d"++multiply :: Text+multiply = "\xe024"++null :: Text+null = "\xe000"++numpad0 :: Text+numpad0 = "\xe01a"++numpad1 :: Text+numpad1 = "\xe01b"++numpad2 :: Text+numpad2 = "\xe01c"++numpad3 :: Text+numpad3 = "\xe01d"++numpad4 :: Text+numpad4 = "\xe01e"++numpad5 :: Text+numpad5 = "\xe01f"++numpad6 :: Text+numpad6 = "\xe020"++numpad7 :: Text+numpad7 = "\xe021"++numpad8 :: Text+numpad8 = "\xe022"++numpad9 :: Text+numpad9 = "\xe023"++pageDown :: Text+pageDown = "\xe00f"++pageUp :: Text+pageUp = "\xe00e"++pause :: Text+pause = "\xe00b"++return :: Text+return = "\xe006"++right :: Text+right = "\xe014"++semicolon :: Text+semicolon = "\xe018"++separator :: Text+separator = "\xe026"++shift :: Text+shift = "\xe008"++space :: Text+space = "\xe00d"++subtract :: Text+subtract = "\xe027"++tab :: Text+tab = "\xe004"++up :: Text+up = "\xe013"+
src/Test/WebDriver/Common/Profile.hs view
@@ -1,260 +1,262 @@-{-# 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 - -import Prelude -- hides some "unused import" warnings - --- |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 +{-# 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++import Prelude -- hides some "unused import" warnings++-- |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++instance ToPref ProfilePref where+ toPref = id++-- |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
@@ -1,96 +1,96 @@-{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleContexts #-} -module Test.WebDriver.Config( - -- * WebDriver configuration - WDConfig(..), defaultConfig - -- * Capabilities helpers - , modifyCaps, useBrowser, useVersion, usePlatform, useProxy - -- * SessionHistoryConfig options - , SessionHistoryConfig, noHistory, unlimitedHistory, onlyMostRecentHistory - -- * Overloadable configuration - , WebDriverConfig(..) - ) where -import Test.WebDriver.Capabilities -import Test.WebDriver.Session - -import Data.Default.Class (Default(..)) -import Data.String (fromString) - -import Control.Monad.Base - -import Network.HTTP.Client (Manager, newManager, defaultManagerSettings) -import Network.HTTP.Types (RequestHeaders) - --- |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 - -- |Base path for all API requests (default "\/wd\/hub") - , wdBasePath :: String - -- |Custom request headers to add to every HTTP request. - , wdRequestHeaders :: RequestHeaders - -- |Custom request headers to add *only* to session creation requests. This is usually done - -- when a WebDriver server requires HTTP auth. - , wdAuthHeaders :: RequestHeaders - -- |Specifies behavior of HTTP request/response history. By default we use 'unlimitedHistory'. - , wdHistoryConfig :: SessionHistoryConfig - -- |Use the given http-client 'Manager' instead of automatically creating one. - , wdHTTPManager :: Maybe Manager - -- |Number of times to retry a HTTP request if it times out (default 0) - , wdHTTPRetryCount :: Int -} - -instance GetCapabilities WDConfig where - getCaps = wdCapabilities - -instance SetCapabilities WDConfig where - setCaps caps conf = conf { wdCapabilities = caps } - -instance Default WDConfig where - def = WDConfig { - wdHost = "127.0.0.1" - , wdPort = 4444 - , wdRequestHeaders = [] - , wdAuthHeaders = [] - , wdCapabilities = def - , wdHistoryConfig = unlimitedHistory - , wdBasePath = "/wd/hub" - , wdHTTPManager = Nothing - , wdHTTPRetryCount = 0 - } - -{- |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 - --- |Class of types that can configure a WebDriver session. -class WebDriverConfig c where - -- |Produces a 'Capabilities' from the given configuration. - mkCaps :: MonadBase IO m => c -> m Capabilities - - -- |Produces a 'WDSession' from the given configuration. - mkSession :: MonadBase IO m => c -> m WDSession - -instance WebDriverConfig WDConfig where - mkCaps = return . getCaps - - mkSession WDConfig{..} = do - manager <- maybe createManager return wdHTTPManager - return WDSession { wdSessHost = fromString $ wdHost - , wdSessPort = wdPort - , wdSessRequestHeaders = wdRequestHeaders - , wdSessAuthHeaders = wdAuthHeaders - , wdSessBasePath = fromString $ wdBasePath - , wdSessId = Nothing - , wdSessHist = [] - , wdSessHistUpdate = wdHistoryConfig - , wdSessHTTPManager = manager - , wdSessHTTPRetryCount = wdHTTPRetryCount } - where - createManager = liftBase $ newManager defaultManagerSettings +{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleContexts #-}+module Test.WebDriver.Config(+ -- * WebDriver configuration+ WDConfig(..), defaultConfig+ -- * Capabilities helpers+ , modifyCaps, useBrowser, useVersion, usePlatform, useProxy+ -- * SessionHistoryConfig options+ , SessionHistoryConfig, noHistory, unlimitedHistory, onlyMostRecentHistory+ -- * Overloadable configuration+ , WebDriverConfig(..)+ ) where+import Test.WebDriver.Capabilities+import Test.WebDriver.Session++import Data.Default.Class (Default(..))+import Data.String (fromString)++import Control.Monad.Base++import Network.HTTP.Client (Manager, newManager, defaultManagerSettings)+import Network.HTTP.Types (RequestHeaders)++-- |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+ -- |Base path for all API requests (default "\/wd\/hub")+ , wdBasePath :: String+ -- |Custom request headers to add to every HTTP request.+ , wdRequestHeaders :: RequestHeaders+ -- |Custom request headers to add *only* to session creation requests. This is usually done+ -- when a WebDriver server requires HTTP auth.+ , wdAuthHeaders :: RequestHeaders+ -- |Specifies behavior of HTTP request/response history. By default we use 'unlimitedHistory'.+ , wdHistoryConfig :: SessionHistoryConfig+ -- |Use the given http-client 'Manager' instead of automatically creating one.+ , wdHTTPManager :: Maybe Manager+ -- |Number of times to retry a HTTP request if it times out (default 0)+ , wdHTTPRetryCount :: Int+}++instance GetCapabilities WDConfig where+ getCaps = wdCapabilities++instance SetCapabilities WDConfig where+ setCaps caps conf = conf { wdCapabilities = caps }++instance Default WDConfig where+ def = WDConfig {+ wdHost = "127.0.0.1"+ , wdPort = 4444+ , wdRequestHeaders = []+ , wdAuthHeaders = []+ , wdCapabilities = def+ , wdHistoryConfig = unlimitedHistory+ , wdBasePath = "/wd/hub"+ , wdHTTPManager = Nothing+ , wdHTTPRetryCount = 0+ }++{- |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++-- |Class of types that can configure a WebDriver session.+class WebDriverConfig c where+ -- |Produces a 'Capabilities' from the given configuration.+ mkCaps :: MonadBase IO m => c -> m Capabilities++ -- |Produces a 'WDSession' from the given configuration.+ mkSession :: MonadBase IO m => c -> m WDSession++instance WebDriverConfig WDConfig where+ mkCaps = return . getCaps++ mkSession WDConfig{..} = do+ manager <- maybe createManager return wdHTTPManager+ return WDSession { wdSessHost = fromString $ wdHost+ , wdSessPort = wdPort+ , wdSessRequestHeaders = wdRequestHeaders+ , wdSessAuthHeaders = wdAuthHeaders+ , wdSessBasePath = fromString $ wdBasePath+ , wdSessId = Nothing+ , wdSessHist = []+ , wdSessHistUpdate = wdHistoryConfig+ , wdSessHTTPManager = manager+ , wdSessHTTPRetryCount = wdHTTPRetryCount }+ where+ createManager = liftBase $ newManager defaultManagerSettings
src/Test/WebDriver/Exceptions.hs view
@@ -1,11 +1,11 @@-module Test.WebDriver.Exceptions - ( InvalidURL(..), NoSessionId(..), BadJSON(..) - , HTTPStatusUnknown(..), HTTPConnError(..) - , UnknownCommand(..), ServerError(..) - , FailedCommand(..), FailedCommandType(..) - , FailedCommandInfo(..), StackFrame(..) - , mkFailedCommandInfo, failedCommand - ) where -import Test.WebDriver.JSON -import Test.WebDriver.Commands.Internal +module Test.WebDriver.Exceptions+ ( InvalidURL(..), NoSessionId(..), BadJSON(..)+ , HTTPStatusUnknown(..), HTTPConnError(..)+ , UnknownCommand(..), ServerError(..)+ , FailedCommand(..), FailedCommandType(..)+ , FailedCommandInfo(..), StackFrame(..)+ , mkFailedCommandInfo, failedCommand+ ) where+import Test.WebDriver.JSON+import Test.WebDriver.Commands.Internal import Test.WebDriver.Exceptions.Internal
src/Test/WebDriver/Exceptions/Internal.hs view
@@ -1,181 +1,181 @@-{-# LANGUAGE OverloadedStrings, RecordWildCards, DeriveDataTypeable, ConstraintKinds, FlexibleContexts #-} -module Test.WebDriver.Exceptions.Internal - ( InvalidURL(..), HTTPStatusUnknown(..), HTTPConnError(..) - , UnknownCommand(..), ServerError(..) - - , FailedCommand(..), failedCommand, mkFailedCommandInfo - , FailedCommandType(..), FailedCommandInfo(..), StackFrame(..) - ) where -import Test.WebDriver.Session -import Test.WebDriver.JSON - -import Data.Aeson -import Data.Aeson.Types (Parser, typeMismatch) -import Data.ByteString.Lazy.Char8 (ByteString) -import Data.Text (Text) -import qualified Data.Text.Lazy.Encoding as TLE - -import Control.Exception (Exception) -import Control.Exception.Lifted (throwIO) -import Control.Applicative - -import Data.Typeable (Typeable) -import Data.Maybe (fromMaybe, catMaybes) -import Data.Word - -import Prelude -- hides some "unused import" warnings - -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 :: (WDSessionStateIO 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 - <*> (catMaybes <$> 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 +{-# LANGUAGE OverloadedStrings, RecordWildCards, DeriveDataTypeable, ConstraintKinds, FlexibleContexts #-}+module Test.WebDriver.Exceptions.Internal+ ( InvalidURL(..), HTTPStatusUnknown(..), HTTPConnError(..)+ , UnknownCommand(..), ServerError(..)++ , FailedCommand(..), failedCommand, mkFailedCommandInfo+ , FailedCommandType(..), FailedCommandInfo(..), StackFrame(..)+ ) where+import Test.WebDriver.Session+import Test.WebDriver.JSON++import Data.Aeson+import Data.Aeson.Types (Parser, typeMismatch)+import Data.ByteString.Lazy.Char8 (ByteString)+import Data.Text (Text)+import qualified Data.Text.Lazy.Encoding as TLE++import Control.Exception (Exception)+import Control.Exception.Lifted (throwIO)+import Control.Applicative++import Data.Typeable (Typeable)+import Data.Maybe (fromMaybe, catMaybes)+import Data.Word++import Prelude -- hides some "unused import" warnings++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 :: (WDSessionStateIO 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 :: Int+ }+ 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+ <*> (catMaybes <$> 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/Firefox/Profile.hs view
@@ -1,241 +1,241 @@-{-# 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.ByteString.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 !MIN_VERSION_base(4,6,0) || 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 = do - prefFileExists <- doesFileExist userPrefFile - if prefFileExists - then HM.fromList <$> (parsePrefs =<< BS.readFile userPrefFile) - else return HM.empty - 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 "" +{-# 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.ByteString.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 !MIN_VERSION_base(4,6,0) || 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 = do+ prefFileExists <- doesFileExist userPrefFile+ if prefFileExists+ then HM.fromList <$> (parsePrefs =<< BS.readFile userPrefFile)+ else return HM.empty+ 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
@@ -1,224 +1,227 @@-{-# LANGUAGE FlexibleContexts, OverloadedStrings, RecordWildCards, ScopedTypeVariables, ConstraintKinds, PatternGuards, CPP #-} --- |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(..) - ) where -import Test.WebDriver.Class -import Test.WebDriver.JSON -import Test.WebDriver.Session -import Test.WebDriver.Exceptions.Internal - -import Network.HTTP.Client (httpLbs, Request(..), RequestBody(..), Response(..), HttpException(..)) -import qualified Network.HTTP.Client as HTTPClient - -import Network.HTTP.Types.Header -import Network.HTTP.Types.Status (Status(..)) -import Data.Aeson -import Data.Aeson.Types (typeMismatch) - -import Data.Text as T (Text, splitOn, null) -import qualified Data.Text.Encoding as TE -import Data.ByteString.Lazy.Char8 (ByteString) -import Data.ByteString.Lazy.Char8 as LBS (length, unpack, null) -import qualified Data.ByteString.Char8 as BS -import qualified Data.ByteString.Base64.Lazy as B64 -import qualified Data.ByteString.Lazy.Internal as LBS (ByteString(..)) - -import Control.Monad.Base -import Control.Exception.Lifted (throwIO) -import Control.Applicative -import Control.Exception (Exception, SomeException(..), toException, fromException, try) - -import Data.String (fromString) -import Data.Word (Word8) - -#if !MIN_VERSION_http_client(0,4,30) -import Data.Default.Class -#endif - -import Prelude -- hides some "unused import" warnings - ---This is the defintion of fromStrict used by bytestring >= 0.10; we redefine it here to support bytestring < 0.10 -fromStrict :: BS.ByteString -> LBS.ByteString -fromStrict bs | BS.null bs = LBS.Empty - | otherwise = LBS.Chunk bs LBS.Empty - - ---Compatability function to support http-client < 0.4.30 -defaultRequest :: Request -#if MIN_VERSION_http_client(0,4,30) -defaultRequest = HTTPClient.defaultRequest -#else -defaultRequest = def -#endif - --- |Constructs an HTTP 'Request' value when given a list of headers, HTTP request method, and URL fragment -mkRequest :: (WDSessionState s, ToJSON a) => - Method -> Text -> a -> s Request -mkRequest 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 defaultRequest - { host = wdSessHost - , port = wdSessPort - , path = wdSessBasePath `BS.append` TE.encodeUtf8 wdPath - , requestBody = RequestBodyLBS body - , requestHeaders = wdSessRequestHeaders - ++ [ (hAccept, "application/json;charset=UTF-8") - , (hContentType, "application/json;charset=UTF-8") - , (hContentLength, fromString . show . LBS.length $ body) ] - , method = meth } - --- |Sends an HTTP request to the remote WebDriver server -sendHTTPRequest :: (WDSessionStateIO s) => Request -> s (Either SomeException (Response ByteString)) -sendHTTPRequest req = do - s@WDSession{..} <- getSession - (nRetries, tryRes) <- liftBase . retryOnTimeout wdSessHTTPRetryCount $ httpLbs req wdSessHTTPManager - let h = SessionHistory { histRequest = req - , histResponse = tryRes - , histRetryCount = nRetries - } - putSession s { wdSessHist = wdSessHistUpdate h wdSessHist } - return tryRes - -retryOnTimeout :: Int -> IO a -> IO (Int, (Either SomeException a)) -retryOnTimeout maxRetry go = retry' 0 - where - retry' nRetries = do - eitherV <- try go - case eitherV of - (Left e) -#if MIN_VERSION_http_client(0,5,0) - | Just (HTTPClient.HttpExceptionRequest _ HTTPClient.ResponseTimeout) <- fromException e -#else - | Just HTTPClient.ResponseTimeout <- fromException e -#endif - , maxRetry > nRetries - -> retry' (succ nRetries) - other -> return (nRetries, other) - --- |Parses a 'WDResponse' object from a given HTTP response. -getJSONResult :: (WDSessionStateControl s, FromJSON a) => Response ByteString -> s (Either SomeException a) -getJSONResult r - --malformed request errors - | code >= 400 && code < 500 = do - lastReq <- mostRecentHTTPRequest <$> 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 fromStrict $ lookup "X-Response-Body-Start" headers) - >>= handleJSONErr - >>= maybe returnNull 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)} - returnNull - -- No Content response - | code == 204 = returnNull - -- HTTP Success - | code >= 200 && code < 300 = - if LBS.null body - then returnNull - 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 - returnNull = Right <$> fromJSON' Null - --HTTP response variables - code = statusCode status - reason = BS.unpack $ statusMessage status - status = responseStatus r - body = responseBody r - headers = responseHeaders r - -handleRespSessionId :: (WDSessionStateIO 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 :: (WDSessionStateControl 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 - - +{-# LANGUAGE FlexibleContexts, OverloadedStrings, RecordWildCards, ScopedTypeVariables, ConstraintKinds, PatternGuards, CPP #-}+-- |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(..)+ ) where+import Test.WebDriver.Class+import Test.WebDriver.JSON+import Test.WebDriver.Session+import Test.WebDriver.Exceptions.Internal++import Network.HTTP.Client (httpLbs, Request(..), RequestBody(..), Response(..))+import qualified Network.HTTP.Client as HTTPClient++import Network.HTTP.Types.Header+import Network.HTTP.Types.Status (Status(..))+import Data.Aeson+import Data.Aeson.Types (typeMismatch)++import Data.Text as T (Text, splitOn, null)+import qualified Data.Text.Encoding as TE+import Data.ByteString.Lazy.Char8 (ByteString)+import Data.ByteString.Lazy.Char8 as LBS (length, unpack, null)+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Base64.Lazy as B64+import qualified Data.ByteString.Lazy.Internal as LBS (ByteString(..)) ++import Control.Monad.Base+import Control.Exception.Lifted (throwIO)+import Control.Applicative+import Control.Exception (Exception, SomeException(..), toException, fromException, try)++import Data.String (fromString)+import Data.Word (Word8)++#if !MIN_VERSION_http_client(0,4,30)+import Data.Default.Class+#endif++import Prelude -- hides some "unused import" warnings++--This is the defintion of fromStrict used by bytestring >= 0.10; we redefine it here to support bytestring < 0.10+fromStrict :: BS.ByteString -> LBS.ByteString+fromStrict bs | BS.null bs = LBS.Empty+ | otherwise = LBS.Chunk bs LBS.Empty++ +--Compatability function to support http-client < 0.4.30+defaultRequest :: Request+#if MIN_VERSION_http_client(0,4,30)+defaultRequest = HTTPClient.defaultRequest+#else+defaultRequest = def+#endif++-- |Constructs an HTTP 'Request' value when given a list of headers, HTTP request method, and URL fragment+mkRequest :: (WDSessionState s, ToJSON a) =>+ Method -> Text -> a -> s Request+mkRequest 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 defaultRequest+ { host = wdSessHost+ , port = wdSessPort+ , path = wdSessBasePath `BS.append` TE.encodeUtf8 wdPath+ , requestBody = RequestBodyLBS body+ , requestHeaders = wdSessRequestHeaders+ ++ [ (hAccept, "application/json;charset=UTF-8")+ , (hContentType, "application/json;charset=UTF-8") ]+ , method = meth +#if !MIN_VERSION_http_client(0,5,0)+ , checkStatus = \_ _ _ -> Nothing+#endif+ }++-- |Sends an HTTP request to the remote WebDriver server+sendHTTPRequest :: (WDSessionStateIO s) => Request -> s (Either SomeException (Response ByteString))+sendHTTPRequest req = do+ s@WDSession{..} <- getSession+ (nRetries, tryRes) <- liftBase . retryOnTimeout wdSessHTTPRetryCount $ httpLbs req wdSessHTTPManager+ let h = SessionHistory { histRequest = req+ , histResponse = tryRes+ , histRetryCount = nRetries+ }+ putSession s { wdSessHist = wdSessHistUpdate h wdSessHist } + return tryRes++retryOnTimeout :: Int -> IO a -> IO (Int, (Either SomeException a))+retryOnTimeout maxRetry go = retry' 0+ where+ retry' nRetries = do+ eitherV <- try go+ case eitherV of+ (Left e)+#if MIN_VERSION_http_client(0,5,0)+ | Just (HTTPClient.HttpExceptionRequest _ HTTPClient.ResponseTimeout) <- fromException e+#else+ | Just HTTPClient.ResponseTimeout <- fromException e+#endif+ , maxRetry > nRetries + -> retry' (succ nRetries)+ other -> return (nRetries, other)+ +-- |Parses a 'WDResponse' object from a given HTTP response.+getJSONResult :: (WDSessionStateControl s, FromJSON a) => Response ByteString -> s (Either SomeException a)+getJSONResult r+ --malformed request errors+ | code >= 400 && code < 500 = do+ lastReq <- mostRecentHTTPRequest <$> 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 fromStrict $ lookup "X-Response-Body-Start" headers)+ >>= handleJSONErr+ >>= maybe returnNull 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)}+ returnNull+ -- No Content response+ | code == 204 = returnNull+ -- HTTP Success+ | code >= 200 && code < 300 = + if LBS.null body+ then returnNull+ 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+ returnNull = Right <$> fromJSON' Null+ --HTTP response variables+ code = statusCode status+ reason = BS.unpack $ statusMessage status+ status = responseStatus r + body = responseBody r + headers = responseHeaders r++handleRespSessionId :: (WDSessionStateIO 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 :: (WDSessionStateControl 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++
src/Test/WebDriver/JSON.hs view
@@ -1,151 +1,151 @@-{-# 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(..) - -- * parsing commands with no return value - , NoReturn(..), noReturn, ignoreReturn - ) where -import Test.WebDriver.Class (WebDriver) - -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.Monad (join, void) -import Control.Applicative -import Control.Monad.Trans.Control -import Control.Exception.Lifted -import Data.String -import Data.Typeable - -import Prelude -- hides some "unused import" warnings - -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 (String "") = return NoReturn - parseJSON other = typeMismatch "no return value" other - --- |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 - - --- |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 - --- |Due to a breaking change in the '.:?' operator of aeson 0.10 (see <https://github.com/bos/aeson/issues/287>) that was subsequently reverted, this operator --- was added to provide consistent behavior compatible with all aeson versions. If the field is either missing or `Null`, this operator should return a `Nothing` result. -(.:??) :: FromJSON a => Object -> Text -> Parser (Maybe a) -o .:?? k = fmap join (o .:? k) - - --- |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 +{-# 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(..)+ -- * parsing commands with no return value+ , NoReturn(..), noReturn, ignoreReturn+ ) where+import Test.WebDriver.Class (WebDriver)++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.Monad (join, void)+import Control.Applicative+import Control.Monad.Trans.Control+import Control.Exception.Lifted+import Data.String+import Data.Typeable++import Prelude -- hides some "unused import" warnings++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 (String "") = return NoReturn+ parseJSON other = typeMismatch "no return value" other++-- |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+++-- |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++-- |Due to a breaking change in the '.:?' operator of aeson 0.10 (see <https://github.com/bos/aeson/issues/287>) that was subsequently reverted, this operator+-- was added to provide consistent behavior compatible with all aeson versions. If the field is either missing or `Null`, this operator should return a `Nothing` result.+(.:??) :: FromJSON a => Object -> Text -> Parser (Maybe a)+o .:?? k = fmap join (o .:? k)+++-- |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
@@ -1,99 +1,99 @@-{-# LANGUAGE FlexibleContexts, TypeFamilies, GeneralizedNewtypeDeriving, - MultiParamTypeClasses, CPP, UndecidableInstances, ConstraintKinds #-} -module Test.WebDriver.Monad - ( WD(..), runWD, runSession, finallyClose, closeOnException, getSessionHistory, 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.IO.Class -import Control.Monad.Fix -import Control.Monad.Trans.Control (MonadBaseControl(..), StM) -import Control.Monad.Trans.State.Strict (StateT, evalStateT, get, put) ---import Control.Monad.IO.Class (MonadIO) -import Control.Exception.Lifted -import Control.Monad.Catch (MonadThrow, MonadCatch) -import Control.Applicative - -import Prelude -- hides some "unused import" warnings - - -{- |A state monad for WebDriver commands. --} -newtype WD a = WD (StateT WDSession IO a) - deriving (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadCatch, MonadFix) - -instance MonadBase IO WD where - liftBase = WD . liftBase - -instance MonadBaseControl IO WD where -#if MIN_VERSION_monad_control(1,0,0) - type StM WD a = StM (StateT WDSession IO) a - - liftBaseWith f = WD $ - liftBaseWith $ \runInBase -> - f (\(WD sT) -> runInBase $ sT) - - restoreM = WD . restoreM -#else - 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 -#endif - -instance WDSessionState WD where - getSession = WD get - putSession = WD . put - -instance WebDriver WD where - doCommand method path args = - mkRequest method path args - >>= sendHTTPRequest - >>= either throwIO return - >>= getJSONResult - >>= either throwIO return - --- |Executes a 'WD' computation within the 'IO' monad, using the given --- 'WDSession' as state for WebDriver requests. -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 when complete. If you want this behavior, use 'finallyClose'. --- Example: --- --- > runSessionThenClose action = runSession myConfig . finallyClose $ action -runSession :: WebDriverConfig conf => conf -> WD a -> IO a -runSession conf wd = do - sess <- mkSession conf - caps <- mkCaps conf - runWD sess $ createSession caps >> wd - --- |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 - --- |Gets the command history for the current session. -getSessionHistory :: WDSessionState wd => wd [SessionHistory] -getSessionHistory = fmap wdSessHist getSession - --- |Prints a history of API requests to stdout after computing the given action. -dumpSessionHistory :: WDSessionStateControl wd => wd a -> wd a -dumpSessionHistory = (`finally` (getSession >>= liftBase . print . wdSessHist)) +{-# LANGUAGE FlexibleContexts, TypeFamilies, GeneralizedNewtypeDeriving,+ MultiParamTypeClasses, CPP, UndecidableInstances, ConstraintKinds #-}+module Test.WebDriver.Monad+ ( WD(..), runWD, runSession, finallyClose, closeOnException, getSessionHistory, 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.IO.Class+import Control.Monad.Fix+import Control.Monad.Trans.Control (MonadBaseControl(..), StM)+import Control.Monad.Trans.State.Strict (StateT, evalStateT, get, put)+--import Control.Monad.IO.Class (MonadIO)+import Control.Exception.Lifted+import Control.Monad.Catch (MonadThrow, MonadCatch)+import Control.Applicative++import Prelude -- hides some "unused import" warnings+++{- |A state monad for WebDriver commands.+-}+newtype WD a = WD (StateT WDSession IO a)+ deriving (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadCatch, MonadFix)++instance MonadBase IO WD where+ liftBase = WD . liftBase++instance MonadBaseControl IO WD where+#if MIN_VERSION_monad_control(1,0,0)+ type StM WD a = StM (StateT WDSession IO) a++ liftBaseWith f = WD $+ liftBaseWith $ \runInBase ->+ f (\(WD sT) -> runInBase $ sT)++ restoreM = WD . restoreM+#else+ 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+#endif++instance WDSessionState WD where+ getSession = WD get+ putSession = WD . put++instance WebDriver WD where+ doCommand method path args =+ mkRequest method path args+ >>= sendHTTPRequest+ >>= either throwIO return+ >>= getJSONResult+ >>= either throwIO return++-- |Executes a 'WD' computation within the 'IO' monad, using the given+-- 'WDSession' as state for WebDriver requests.+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 when complete. If you want this behavior, use 'finallyClose'.+-- Example:+--+-- > runSessionThenClose action = runSession myConfig . finallyClose $ action+runSession :: WebDriverConfig conf => conf -> WD a -> IO a+runSession conf wd = do+ sess <- mkSession conf+ caps <- mkCaps conf+ runWD sess $ createSession caps >> wd++-- |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++-- |Gets the command history for the current session.+getSessionHistory :: WDSessionState wd => wd [SessionHistory]+getSessionHistory = fmap wdSessHist getSession ++-- |Prints a history of API requests to stdout after computing the given action.+dumpSessionHistory :: WDSessionStateControl wd => wd a -> wd a+dumpSessionHistory = (`finally` (getSession >>= liftBase . print . wdSessHist))
src/Test/WebDriver/Session.hs view
@@ -1,211 +1,211 @@-{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, FlexibleContexts, ScopedTypeVariables, - GeneralizedNewtypeDeriving, RecordWildCards, ConstraintKinds, CPP #-} - -#ifndef CABAL_BUILD_DEVELOPER -{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -#endif - -module Test.WebDriver.Session - ( -- * WDSessionState class - WDSessionState(..), WDSessionStateIO, WDSessionStateControl, modifySession, withSession - -- ** WebDriver sessions - , WDSession(..), mostRecentHistory, mostRecentHTTPRequest, SessionId(..), SessionHistory(..) - -- * SessionHistoryConfig options - , SessionHistoryConfig, noHistory, unlimitedHistory, onlyMostRecentHistory - -- * Using custom HTTP request headers - , withRequestHeaders, withAuthHeaders - ) where - -import Test.WebDriver.Session.History - -import Data.Aeson -import Data.ByteString as BS(ByteString) -import Data.Text (Text) -import Data.Maybe (listToMaybe) -import Data.Monoid - -import Control.Applicative -import Control.Monad.Base -import Control.Monad.Trans.Class -import Control.Monad.Trans.Control -import Control.Monad.Trans.Maybe -import Control.Monad.Trans.Identity -import Control.Monad.Trans.List -import Control.Monad.Trans.Reader -import Control.Monad.Trans.Error -import Control.Monad.Trans.Except ---import Control.Monad.Cont -import Control.Monad.Trans.Writer.Strict as SW -import Control.Monad.Trans.Writer.Lazy as LW -import Control.Monad.Trans.State.Strict as SS -import Control.Monad.Trans.State.Lazy as LS -import Control.Monad.Trans.RWS.Strict as SRWS -import Control.Monad.Trans.RWS.Lazy as LRWS - -import Control.Exception.Lifted (SomeException, try, throwIO) - ---import Network.HTTP.Types.Header (RequestHeaders) -import Network.HTTP.Client (Manager, Request) -import Network.HTTP.Types (RequestHeaders) - -import Prelude -- hides some "redundant import" warnings - -{- |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 :: [SessionHistory] - -- |Update function used to append new entries to session history - , wdSessHistUpdate :: SessionHistoryConfig - -- |HTTP 'Manager' used for connection pooling by the http-client library. - , wdSessHTTPManager :: Manager - -- |Number of times to retry a HTTP request if it times out - , wdSessHTTPRetryCount :: Int - -- |Custom request headers to add to every HTTP request. - , wdSessRequestHeaders :: RequestHeaders - -- |Custom request headers to add *only* to session creation requests. This is usually done - -- when a WebDriver server requires HTTP auth. - , wdSessAuthHeaders :: RequestHeaders - } - - --- |A function used by 'wdHistoryConfig' to append new entries to session history. -type SessionHistoryConfig = SessionHistory -> [SessionHistory] -> [SessionHistory] - --- |No session history is saved. -noHistory :: SessionHistoryConfig -noHistory _ _ = [] - --- |Keep unlimited history -unlimitedHistory :: SessionHistoryConfig -unlimitedHistory = (:) - --- |Saves only the most recent history -onlyMostRecentHistory :: SessionHistoryConfig -onlyMostRecentHistory h _ = [h] - --- |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 (Monad m, Applicative m) => WDSessionState m where - - -- |Retrieves the current session state of the monad - getSession :: m WDSession - - -- |Sets a new session state for the monad - putSession :: WDSession -> m () - --- |Constraint synonym for the common pairing of 'WDSessionState' and 'MonadBase' 'IO'. -type WDSessionStateIO s = (WDSessionState s, MonadBase IO s) - --- |Constraint synonym for another common pairing of 'WDSessionState' and 'MonadBaseControl' 'IO'. This --- is commonly used in library types to indicate use of lifted exception handling. -type WDSessionStateControl s = (WDSessionState s, MonadBaseControl IO s) - -modifySession :: WDSessionState s => (WDSession -> WDSession) -> s () -modifySession f = getSession >>= putSession . f - --- |Locally sets a session state for use within the given action. --- The state of any outside action is unaffected by this function. --- This function is useful if you need to work with multiple sessions simultaneously. -withSession :: WDSessionStateControl m => WDSession -> m a -> m a -withSession s m = do - s' <- getSession - putSession s - (a :: Either SomeException a) <- try m - putSession s' - either throwIO return a - --- |The most recent SessionHistory entry recorded by this session, if any. -mostRecentHistory :: WDSession -> Maybe SessionHistory -mostRecentHistory = listToMaybe . wdSessHist - --- |The most recent HTTP request issued by this session, if any. -mostRecentHTTPRequest :: WDSession -> Maybe Request -mostRecentHTTPRequest = fmap histRequest . mostRecentHistory - --- |Set a temporary list of custom 'RequestHeaders' to use within the given action. --- All previous custom headers are temporarily removed, and then restored at the end. -withRequestHeaders :: WDSessionStateControl m => RequestHeaders -> m a -> m a -withRequestHeaders h m = do - h' <- fmap wdSessRequestHeaders getSession - modifySession $ \s -> s { wdSessRequestHeaders = h } - (a :: Either SomeException a) <- try m - modifySession $ \s -> s { wdSessRequestHeaders = h' } - either throwIO return a - --- |Makes all webdriver HTTP requests in the given action use the session\'s auth headers, typically --- configured by setting the 'wdAuthHeaders' config. This is useful if you want to temporarily use --- the same auth headers you used for session creation with other HTTP requests. -withAuthHeaders :: WDSessionStateControl m => m a -> m a -withAuthHeaders wd = do - authHeaders <- fmap wdSessAuthHeaders getSession - withRequestHeaders authHeaders wd - -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 WDSessionState m => WDSessionState (ListT 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 (Monoid w, WDSessionState m) => WDSessionState (SW.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 WDSessionState m => WDSessionState (ExceptT r 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 +{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, FlexibleContexts, ScopedTypeVariables,+ GeneralizedNewtypeDeriving, RecordWildCards, ConstraintKinds, CPP #-}++#ifndef CABAL_BUILD_DEVELOPER+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}+#endif++module Test.WebDriver.Session+ ( -- * WDSessionState class+ WDSessionState(..), WDSessionStateIO, WDSessionStateControl, modifySession, withSession+ -- ** WebDriver sessions+ , WDSession(..), mostRecentHistory, mostRecentHTTPRequest, SessionId(..), SessionHistory(..)+ -- * SessionHistoryConfig options+ , SessionHistoryConfig, noHistory, unlimitedHistory, onlyMostRecentHistory+ -- * Using custom HTTP request headers+ , withRequestHeaders, withAuthHeaders+ ) where++import Test.WebDriver.Session.History++import Data.Aeson+import Data.ByteString as BS(ByteString) +import Data.Text (Text)+import Data.Maybe (listToMaybe)+import Data.Monoid++import Control.Applicative+import Control.Monad.Base+import Control.Monad.Trans.Class+import Control.Monad.Trans.Control+import Control.Monad.Trans.Maybe+import Control.Monad.Trans.Identity+import Control.Monad.Trans.List+import Control.Monad.Trans.Reader+import Control.Monad.Trans.Error+import Control.Monad.Trans.Except+--import Control.Monad.Cont+import Control.Monad.Trans.Writer.Strict as SW+import Control.Monad.Trans.Writer.Lazy as LW+import Control.Monad.Trans.State.Strict as SS+import Control.Monad.Trans.State.Lazy as LS+import Control.Monad.Trans.RWS.Strict as SRWS+import Control.Monad.Trans.RWS.Lazy as LRWS++import Control.Exception.Lifted (SomeException, try, throwIO)++--import Network.HTTP.Types.Header (RequestHeaders)+import Network.HTTP.Client (Manager, Request)+import Network.HTTP.Types (RequestHeaders)++import Prelude -- hides some "redundant import" warnings++{- |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 :: [SessionHistory]+ -- |Update function used to append new entries to session history+ , wdSessHistUpdate :: SessionHistoryConfig+ -- |HTTP 'Manager' used for connection pooling by the http-client library.+ , wdSessHTTPManager :: Manager+ -- |Number of times to retry a HTTP request if it times out+ , wdSessHTTPRetryCount :: Int+ -- |Custom request headers to add to every HTTP request. + , wdSessRequestHeaders :: RequestHeaders+ -- |Custom request headers to add *only* to session creation requests. This is usually done+ -- when a WebDriver server requires HTTP auth.+ , wdSessAuthHeaders :: RequestHeaders+ }+++-- |A function used by 'wdHistoryConfig' to append new entries to session history.+type SessionHistoryConfig = SessionHistory -> [SessionHistory] -> [SessionHistory]++-- |No session history is saved.+noHistory :: SessionHistoryConfig+noHistory _ _ = []++-- |Keep unlimited history+unlimitedHistory :: SessionHistoryConfig+unlimitedHistory = (:)++-- |Saves only the most recent history+onlyMostRecentHistory :: SessionHistoryConfig+onlyMostRecentHistory h _ = [h]++-- |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 (Monad m, Applicative m) => WDSessionState m where+ + -- |Retrieves the current session state of the monad+ getSession :: m WDSession+ + -- |Sets a new session state for the monad+ putSession :: WDSession -> m ()++-- |Constraint synonym for the common pairing of 'WDSessionState' and 'MonadBase' 'IO'.+type WDSessionStateIO s = (WDSessionState s, MonadBase IO s)++-- |Constraint synonym for another common pairing of 'WDSessionState' and 'MonadBaseControl' 'IO'. This+-- is commonly used in library types to indicate use of lifted exception handling.+type WDSessionStateControl s = (WDSessionState s, MonadBaseControl IO s) ++modifySession :: WDSessionState s => (WDSession -> WDSession) -> s ()+modifySession f = getSession >>= putSession . f++-- |Locally sets a session state for use within the given action.+-- The state of any outside action is unaffected by this function.+-- This function is useful if you need to work with multiple sessions simultaneously.+withSession :: WDSessionStateControl m => WDSession -> m a -> m a+withSession s m = do+ s' <- getSession+ putSession s+ (a :: Either SomeException a) <- try m+ putSession s'+ either throwIO return a++-- |The most recent SessionHistory entry recorded by this session, if any.+mostRecentHistory :: WDSession -> Maybe SessionHistory+mostRecentHistory = listToMaybe . wdSessHist+ +-- |The most recent HTTP request issued by this session, if any.+mostRecentHTTPRequest :: WDSession -> Maybe Request+mostRecentHTTPRequest = fmap histRequest . mostRecentHistory++-- |Set a temporary list of custom 'RequestHeaders' to use within the given action.+-- All previous custom headers are temporarily removed, and then restored at the end.+withRequestHeaders :: WDSessionStateControl m => RequestHeaders -> m a -> m a+withRequestHeaders h m = do+ h' <- fmap wdSessRequestHeaders getSession+ modifySession $ \s -> s { wdSessRequestHeaders = h }+ (a :: Either SomeException a) <- try m+ modifySession $ \s -> s { wdSessRequestHeaders = h' }+ either throwIO return a++-- |Makes all webdriver HTTP requests in the given action use the session\'s auth headers, typically+-- configured by setting the 'wdAuthHeaders' config. This is useful if you want to temporarily use+-- the same auth headers you used for session creation with other HTTP requests.+withAuthHeaders :: WDSessionStateControl m => m a -> m a+withAuthHeaders wd = do+ authHeaders <- fmap wdSessAuthHeaders getSession+ withRequestHeaders authHeaders wd+ +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 WDSessionState m => WDSessionState (ListT 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 (Monoid w, WDSessionState m) => WDSessionState (SW.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 WDSessionState m => WDSessionState (ExceptT r 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/Session/History.hs view
@@ -1,13 +1,13 @@-module Test.WebDriver.Session.History where - -import Data.ByteString.Lazy (ByteString) -import Network.HTTP.Client (Request, Response) -import Control.Exception (SomeException) - - -data SessionHistory = SessionHistory - { histRequest :: Request - , histResponse :: Either SomeException (Response ByteString) - , histRetryCount :: Int - } - deriving (Show) +module Test.WebDriver.Session.History where++import Data.ByteString.Lazy (ByteString)+import Network.HTTP.Client (Request, Response)+import Control.Exception (SomeException)+++data SessionHistory = SessionHistory + { histRequest :: Request+ , histResponse :: Either SomeException (Response ByteString)+ , histRetryCount :: Int+ }+ deriving (Show)
src/Test/WebDriver/Types.hs view
@@ -1,41 +1,41 @@-{-# OPTIONS_HADDOCK not-home #-} -module Test.WebDriver.Types - ( -- * WebDriver sessions - WD(..), WDSession(..), SessionId(..), SessionHistory - -- * WebDriver configuration - , WDConfig(..), defaultConfig, SessionHistoryConfig - -- * 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 +{-# OPTIONS_HADDOCK not-home #-}+module Test.WebDriver.Types+ ( -- * WebDriver sessions+ WD(..), WDSession(..), SessionId(..), SessionHistory+ -- * WebDriver configuration+ , WDConfig(..), defaultConfig, SessionHistoryConfig+ -- * 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
@@ -1,8 +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 +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
webdriver.cabal view
@@ -1,95 +1,94 @@-Name: webdriver -Version: 0.8.4 -Cabal-Version: >= 1.10 -License: BSD3 -License-File: LICENSE -Author: Adam Curtis -Maintainer: kallisti.dev@gmail.com -Homepage: https://github.com/kallisti-dev/hs-webdriver -Bug-Reports: https://github.com/kallisti-dev/hs-webdriver/issues -Category: Web, Browser, Testing, WebDriver, Selenium -Synopsis: a Haskell client for the Selenium WebDriver protocol -Build-Type: Simple -Extra-Source-Files: README.md, TODO.md, CHANGELOG.md, .ghci -Tested-With: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1 -Description: - 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 - -Flag network-uri - description: Get Network.URI from the network-uri package - default: True - -Flag developer - description: Package development mode - default: False - manual: True - -Library - hs-source-dirs: src - default-language: Haskell2010 - ghc-options: -Wall - if flag(developer) - cpp-options: -DCABAL_BUILD_DEVELOPER - build-depends: base == 4.* - , aeson >= 0.6.2.0 - , http-client >= 0.3 - , http-types >= 0.8 - , text >= 0.11.3 - , bytestring >= 0.9 - , attoparsec >= 0.10 - , base64-bytestring >= 1.0 - , transformers >= 0.4 - , monad-control >= 0.3 - , transformers-base >= 0.1 - , lifted-base >= 0.1 - , zip-archive >= 0.1.1.8 - , directory > 1.0 - , filepath > 1.0 - , directory-tree >= 0.11 - , temporary >= 1.0 - , time > 1.0 - , unordered-containers >= 0.1.3 - , vector >= 0.3 - , exceptions >= 0.4 - , scientific >= 0.2 - , data-default-class - - if flag(network-uri) - build-depends: network-uri >= 2.6, network >= 2.6 - else - build-depends: network-uri < 2.6, network >= 2.4 && < 2.6 - - exposed-modules: Test.WebDriver - Test.WebDriver.Class - Test.WebDriver.Monad - Test.WebDriver.Session - Test.WebDriver.Session.History - Test.WebDriver.Config - Test.WebDriver.Exceptions - Test.WebDriver.Commands - Test.WebDriver.Commands.Wait - Test.WebDriver.Commands.Internal - Test.WebDriver.Common.Profile - Test.WebDriver.Common.Keys - 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.WebDriver.Exceptions.Internal +Name: webdriver+Version: 0.8.5+Cabal-Version: >= 1.10+License: BSD3+License-File: LICENSE+Author: Adam Curtis+Maintainer: kallisti.dev@gmail.com+Homepage: https://github.com/kallisti-dev/hs-webdriver+Bug-Reports: https://github.com/kallisti-dev/hs-webdriver/issues+Category: Web, Browser, Testing, WebDriver, Selenium+Synopsis: a Haskell client for the Selenium WebDriver protocol+Build-Type: Simple+Extra-Source-Files: README.md, TODO.md, CHANGELOG.md, .ghci+Tested-With: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1+Description:+ 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+ +Flag network-uri+ description: Get Network.URI from the network-uri package+ default: True++Flag developer+ description: Package development mode+ default: False+ manual: True++Library+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall+ if flag(developer)+ cpp-options: -DCABAL_BUILD_DEVELOPER+ build-depends: base == 4.*+ , aeson >= 0.6.2.0+ , http-client >= 0.3+ , http-types >= 0.8+ , text >= 0.11.3+ , bytestring >= 0.9+ , attoparsec >= 0.10+ , base64-bytestring >= 1.0+ , transformers >= 0.4+ , monad-control >= 0.3+ , transformers-base >= 0.1+ , lifted-base >= 0.1+ , zip-archive >= 0.1.1.8+ , directory > 1.0+ , filepath > 1.0+ , directory-tree >= 0.11+ , temporary >= 1.0+ , time > 1.0+ , unordered-containers >= 0.1.3+ , vector >= 0.3+ , exceptions >= 0.4+ , scientific >= 0.2+ , data-default-class+ + if flag(network-uri)+ build-depends: network-uri >= 2.6, network >= 2.6+ else+ build-depends: network-uri < 2.6, network >= 2.4 && < 2.6++ exposed-modules: Test.WebDriver+ Test.WebDriver.Class+ Test.WebDriver.Monad+ Test.WebDriver.Session+ Test.WebDriver.Session.History+ Test.WebDriver.Config+ Test.WebDriver.Exceptions+ Test.WebDriver.Commands+ Test.WebDriver.Commands.Wait+ Test.WebDriver.Commands.Internal+ Test.WebDriver.Common.Profile+ Test.WebDriver.Common.Keys+ Test.WebDriver.Firefox.Profile+ Test.WebDriver.Chrome.Extension+ Test.WebDriver.Capabilities+ Test.WebDriver.Types+ Test.WebDriver.JSON+ Test.WebDriver.Utils+ Test.WebDriver.Internal+ Test.WebDriver.Exceptions.Internal