webdriver 0.8.5 → 0.9
raw patch · 10 files changed
+357/−298 lines, 10 filesdep +call-stackdep ~base
Dependencies added: call-stack
Dependency ranges changed: base
Files
- CHANGELOG.md +89/−71
- README.md +5/−2
- src/Test/WebDriver/Capabilities.hs +17/−8
- src/Test/WebDriver/Class.hs +10/−11
- src/Test/WebDriver/Commands.hs +130/−132
- src/Test/WebDriver/Commands/Internal.hs +19/−10
- src/Test/WebDriver/Commands/Wait.hs +22/−21
- src/Test/WebDriver/Exceptions/Internal.hs +29/−10
- src/Test/WebDriver/Internal.hs +33/−31
- webdriver.cabal +3/−2
CHANGELOG.md view
@@ -1,48 +1,66 @@-#Change Log-##0.8.5+# Change Log+## 0.9++### Breaking API changes+* Changed the type of the `cookExpiry` field of `Cookie` from `Maybe Integer` to `Maybe Double`. This fixes parsing issues with some Selenium server implementations+* Changed `elemPos` and `elemSize` to return `Float` pairs instead of `Int` pairs. This fixes parsing issues with some Selemium server implementations.+* Removed the `Element` argument from the `sendRawKeys` function. This argument is not used in modern Selenium versions.++### New API features+* Added a `LogDebug` constructor to the `LogLevel` type.+* Added `ffAccpetInsecureCerts` capability for `Firefox` geckodriver.+* The constructor for `ExpectFailed` is now exported so that it can be caught properly by exception handlers+* Added GHC callstack support. `BadJSON` exceptions are now caught and rethrown with `error` calls to improve stack traces.++### W3C standard compatibility fixes+* Fixed `ToJSON Element` instance so that it accepts both old OSS and new W3C element format (fixes compatibility issue with Selenium 3+ versions)+* Changed the `maximize` API call to use POST instead of GET++### Other Selenium compatibility fixes+* Fixed an error with some versions of chromedriver when using `closeWindow`++## 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+## 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+## 0.8.3 * Removed most upper bounds on dependencies in our cabal file to avoid stackage version madness. -##0.8.2+## 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+## 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+## 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+## 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+## 0.8.0.2 * Fixed issue introduced in 0.8 that caused build failure when using aeson < 0.10 -##0.8.0.1+## 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+## 0.8 -###Command changes+### Command changes * All commands that previously accepted a list parameter now accepts any instance of `Foldable` instead. ---###Overloadable configuration+### 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:@@ -63,25 +81,25 @@ Of course you can still use `WDConfig`, as it is now an instance of `WebDriverConfig`. -###Reworked custom HTTP headers interface+### 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+### 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+## 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)+### 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@@ -104,10 +122,10 @@ dumpSessionHistory :: WDSessionStateControl wd => wd a -> wd a ``` -###Implicit waits API (`Test.WebDriver.Commands.Wait`)+### Implicit waits API (`Test.WebDriver.Commands.Wait`) * Added functions for checking some expected conditions in explicit waits: `expectNotStale`, `expectAlertOpen`, `catchFailedCommand` -###Typeclass API+### 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. @@ -134,7 +152,7 @@ type HasCapabilities t = (GetCapabilities t, SetCapabilities t) ``` -###Minor API changes (not exposed to `Test.WebDriver` module)+### Minor API changes (not exposed to `Test.WebDriver` module) * `Test.WebDriver.Session` changes * new function `mostRecentHistory` added * `lastHTTPRequest` renamed to `mostRecentHTTPRequest` (for consistency)@@ -143,43 +161,43 @@ * `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+### Dependencies * Now supports http-types up to 0.9 -##0.6.3.1+## 0.6.3.1 * Fixed an issue with aeson 0.10 support -##0.6.3+## 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+## 0.6.2.1 * Supports vector 0.11, aeson 0.9, attoparsec 0.13 -##0.6.2+## 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+## 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+## 0.6.0.4 * Support for monad-control 1.0 -##0.6.0.3+## 0.6.0.3 * Relaxed upper bounds on text and http-client versions -##0.6.0.2+## 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+## 0.6.0.1 * Fixed Haddock parse errors. No code changes introduced in this version. -##0.6+## 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@@ -187,105 +205,105 @@ * 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+## 0.5.5 * Added optional HTTP history tracking for debugging purposes. -##0.5.4+## 0.5.4 * MonadCatchIO is deprecated in favour of exceptions. * Relaxed dependencies on mtl, network and scientific. -##0.5.3.3+## 0.5.3.3 * Relaxed text dependency up to 1.2 -##0.5.3.2-###bug fixes+## 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+## 0.5.3.1+### bug fixes * fixed compilation error with aeson 0.7 and greater -##0.5.3+## 0.5.3 -###new features+### new features * SessionNotCreated constructor added to FailedCommandType * new command deleteCookieByName added -###bug fixes+###b ug 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+## 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 features * new command getApplicationCacheStatus supported * error reporting for unknown commands now slightly improved -###bug fixes+### 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+## 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+### 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 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+## 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+### new features * added Test.WebDriver.Commands.screenshotBase64 -##hs-webdriver 0.4+## hs-webdriver 0.4 -###API changes+### 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+### 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+### 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+### 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+### 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+### 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 +### 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@@ -294,40 +312,40 @@ ## hs-webdriver 0.3.2.1 -###bug fixes+### 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+### 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 features * new Common.Profile functions: hasExtension, hasFile ## hs-webdriver 0.3.1 -###API changes+### 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+### 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+### 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+### 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+### 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.
README.md view
@@ -67,10 +67,14 @@ The server should now be listening at localhost on port 4444. +Currently, `hs-webdriver` only supports selenium version 2.+The [beginner example](/examples/readme-example-beginner.md) was+tested with `selenium-server-standalone-2.53.1`.+ ## 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.+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. For other examples see the [examples](examples/) and [test/etc](test/etc/) directory. # Integration with Haskell Testing Frameworks@@ -89,4 +93,3 @@ ``` Haddock will generate documentation and save it in `dist/doc/html/webdriver`-
src/Test/WebDriver/Capabilities.hs view
@@ -193,6 +193,7 @@ -> ["firefox_profile" .= ffProfile ,"loggingPrefs" .= object ["driver" .= ffLogPref] ,"firefox_binary" .= ffBinary+ ,"acceptInsecureCerts" .= fromMaybe False ffAcceptInsecureCerts ] Chrome {..} -> catMaybes [ opt "chrome.chromedriverVersion" chromeDriverVersion ]@@ -233,7 +234,7 @@ ,"opera.autostart" .= operaAutoStart , "opera.idle" .= operaIdle -- ,"opera.profile" .= operaProfile- ,"opera.port" .= fromMaybe (-1) operaPort+ ,"opera.port" .= fromMaybe maxBound {- (-1) -} operaPort --note: consider replacing operaOptions with a list of options ,"opera.arguments" .= operaOptions ,"opera.logging.level" .= operaLogPref@@ -285,14 +286,14 @@ additionalCapabilities = HM.toList . foldr HM.delete o . knownCapabilities knownCapabilities browser =- ["browserName", "version", "platform", "proxy"- ,"javascriptEnabled", "takesScreenshot", "handlesAlerts"- ,"databaseEnabled", "locationContextEnabled"- ,"applicationCacheEnabled", "browserConnectionEnabled"+ [ "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"]+ Firefox {} -> ["firefox_profile", "loggingPrefs", "firefox_binary", "acceptInsecureCerts"] Chrome {} -> ["chrome.chromedriverVersion", "chrome.extensions", "chrome.switches", "chrome.extensions"] IE {} -> ["ignoreProtectedModeSettings", "ignoreZoomSettings", "initialBrowserUrl", "elementScrollBehavior" ,"enablePersistentHover", "enableElementCacheCleanup", "requireWindowFocus", "browserAttachTimeout"@@ -305,6 +306,7 @@ Firefox {} -> Firefox <$> opt "firefox_profile" Nothing <*> opt "loggingPrefs" def <*> opt "firefox_binary" Nothing+ <*> opt "acceptInsecureCerts" Nothing Chrome {} -> Chrome <$> opt "chrome.chromedriverVersion" Nothing <*> opt "chrome.binary" Nothing <*> opt "chrome.switches" []@@ -357,6 +359,11 @@ -- |Server-side path to Firefox binary. If Nothing, -- use a sensible system-based default. , ffBinary :: Maybe FilePath+ -- |Available after Firefox 52, and required only for Firefox+ -- geckodriver. Indicates whether untrusted and self-signed TLS+ -- certificates are implicitly trusted on navigation for the+ -- duration of the session.+ , ffAcceptInsecureCerts :: Maybe Bool } | Chrome { -- |Version of the Chrome Webdriver server server to use --@@ -526,7 +533,7 @@ -- |Default Firefox settings. All Maybe fields are set to Nothing. ffLogPref -- is set to 'LogInfo'. firefox :: Browser-firefox = Firefox Nothing def Nothing+firefox = Firefox Nothing def Nothing Nothing -- |Default Chrome settings. All Maybe fields are set to Nothing, no options are -- specified, and no extensions are used.@@ -679,7 +686,7 @@ -- |Indicates a log verbosity level. Used in 'Firefox' and 'Opera' configuration. data LogLevel = LogOff | LogSevere | LogWarning | LogInfo | LogConfig- | LogFine | LogFiner | LogFinest | LogAll+ | LogFine | LogFiner | LogFinest | LogDebug | LogAll deriving (Eq, Show, Read, Ord, Bounded, Enum) instance Default LogLevel where@@ -695,6 +702,7 @@ LogFine -> "FINE" LogFiner -> "FINER" LogFinest -> "FINEST"+ LogDebug -> "DEBUG" LogAll -> "ALL" instance FromJSON LogLevel where@@ -707,6 +715,7 @@ "FINE" -> LogFine "FINER" -> LogFiner "FINEST" -> LogFinest+ "DEBUG" -> LogDebug "ALL" -> LogAll _ -> throw . BadJSON $ "Invalid logging preference: " ++ show s parseJSON other = typeMismatch "LogLevel" other
src/Test/WebDriver/Class.hs view
@@ -18,27 +18,26 @@ import Network.HTTP.Types.Method (methodDelete, methodGet, methodPost, Method) import Control.Monad.Trans.Class-import Control.Monad.Trans.Maybe+import Control.Monad.Trans.Error+import Control.Monad.Trans.Except import Control.Monad.Trans.Identity import Control.Monad.Trans.List+import Control.Monad.Trans.Maybe+import Control.Monad.Trans.RWS.Lazy as LRWS+import Control.Monad.Trans.RWS.Strict as SRWS 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.Monad.Trans.State.Strict as SS+import Control.Monad.Trans.Writer.Lazy as LW+import Control.Monad.Trans.Writer.Strict as SW+import Data.CallStack -- |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) =>+ doCommand :: (HasCallStack, ToJSON a, FromJSON b) => Method -- ^HTTP request method -> Text -- ^URL of request -> a -- ^JSON parameters passed in the body
src/Test/WebDriver/Commands.hs view
@@ -73,67 +73,65 @@ , 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 Control.Monad+import Control.Monad.Base+import Data.Aeson+import Data.Aeson.TH+import Data.Aeson.Types+import Data.ByteString.Base64.Lazy as B64+import Data.ByteString.Lazy as LBS (ByteString, writeFile)+import Data.CallStack import qualified Data.Char as C+import qualified Data.Foldable as F+import Data.Maybe+import Data.String (fromString)+import Data.Text (Text, append, toUpper, toLower)+import qualified Data.Text as T+import qualified Data.Text.Lazy.Encoding as TL+import Data.Word+import Network.URI hiding (path) -- suppresses warnings+import Test.WebDriver.Capabilities+import Test.WebDriver.Class+import Test.WebDriver.Commands.Internal+import Test.WebDriver.Exceptions.Internal+import Test.WebDriver.JSON+import Test.WebDriver.Session+import Test.WebDriver.Utils (urlEncode) 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. --- +-- |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 :: (HasCallStack, 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 :: (HasCallStack, 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 :: (HasCallStack, WebDriver wd) => wd Capabilities getActualCaps = doSessCommand methodGet "" Null -- |Close the current session and the browser associated with it.-closeSession :: WebDriver wd => wd ()+closeSession :: (HasCallStack, 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 :: (HasCallStack, WebDriver wd) => Integer -> wd () setImplicitWait ms = noReturn $ doSessCommand methodPost "/timeouts/implicit_wait" (object msField) `L.catch` \(_ :: SomeException) ->@@ -143,7 +141,7 @@ -- |Sets the amount of time (ms) we wait for an asynchronous script to return a -- result.-setScriptTimeout :: WebDriver wd => Integer -> wd ()+setScriptTimeout :: (HasCallStack, WebDriver wd) => Integer -> wd () setScriptTimeout ms = noReturn $ doSessCommand methodPost "/timeouts/async_script" (object msField) `L.catch` \( _ :: SomeException) ->@@ -152,31 +150,31 @@ 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 :: (HasCallStack, 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 :: (HasCallStack, WebDriver wd) => wd String getCurrentURL = doSessCommand methodGet "/url" Null -- |Opens a new page by the given URL.-openPage :: WebDriver wd => String -> wd ()+openPage :: (HasCallStack, 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 :: (HasCallStack, WebDriver wd) => wd () forward = noReturn $ doSessCommand methodPost "/forward" Null -- |Navigate backward in the browser history.-back :: WebDriver wd => wd ()+back :: (HasCallStack, WebDriver wd) => wd () back = noReturn $ doSessCommand methodPost "/back" Null -- |Refresh the current page-refresh :: WebDriver wd => wd ()+refresh :: (HasCallStack, WebDriver wd) => wd () refresh = noReturn $ doSessCommand methodPost "/refresh" Null -- |An existential wrapper for any 'ToJSON' instance. This allows us to pass@@ -202,7 +200,7 @@ 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 +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: @@ -216,7 +214,7 @@ 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 +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. @@ -240,7 +238,7 @@ 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 :: (HasCallStack, 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")@@ -248,32 +246,32 @@ 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 :: (HasCallStack, 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 :: (HasCallStack, 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 :: (HasCallStack, WebDriver wd) => wd LBS.ByteString screenshotBase64 = TL.encodeUtf8 <$> doSessCommand methodGet "/screenshot" Null -availableIMEEngines :: WebDriver wd => wd [Text]+availableIMEEngines :: (HasCallStack, WebDriver wd) => wd [Text] availableIMEEngines = doSessCommand methodGet "/ime/available_engines" Null -activeIMEEngine :: WebDriver wd => wd Text+activeIMEEngine :: (HasCallStack, WebDriver wd) => wd Text activeIMEEngine = doSessCommand methodGet "/ime/active_engine" Null -checkIMEActive :: WebDriver wd => wd Bool+checkIMEActive :: (HasCallStack, WebDriver wd) => wd Bool checkIMEActive = doSessCommand methodGet "/ime/activated" Null -activateIME :: WebDriver wd => Text -> wd ()+activateIME :: (HasCallStack, WebDriver wd) => Text -> wd () activateIME = noReturn . doSessCommand methodPost "/ime/activate" . single "engine" -deactivateIME :: WebDriver wd => wd ()+deactivateIME :: (HasCallStack, WebDriver wd) => wd () deactivateIME = noReturn $ doSessCommand methodPost "/ime/deactivate" Null @@ -296,49 +294,49 @@ DefaultFrame -> Null -- |Switch focus to the frame specified by the FrameSelector.-focusFrame :: WebDriver wd => FrameSelector -> wd ()+focusFrame :: (HasCallStack, 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 :: (HasCallStack, 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 :: (HasCallStack, WebDriver wd) => wd [WindowHandle] windows = doSessCommand methodGet "/window_handles" Null -focusWindow :: WebDriver wd => WindowHandle -> wd ()+focusWindow :: (HasCallStack, WebDriver wd) => WindowHandle -> wd () focusWindow w = noReturn $ doSessCommand methodPost "/window" . single "name" $ w -- |Closes the given window-closeWindow :: WebDriver wd => WindowHandle -> wd ()+closeWindow :: (HasCallStack, WebDriver wd) => WindowHandle -> wd () closeWindow w = do cw <- getCurrentWindow focusWindow w- noReturn $ doSessCommand methodDelete "/window" Null+ ignoreReturn $ 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+maximize :: (HasCallStack, WebDriver wd) => wd ()+maximize = ignoreReturn $ doWinCommand methodPost currentWindow "/maximize" Null -- |Get the dimensions of the current window.-getWindowSize :: WebDriver wd => wd (Word, Word)+getWindowSize :: (HasCallStack, 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 :: (HasCallStack, 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 :: (HasCallStack, 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 :: (HasCallStack, 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@@ -353,7 +351,7 @@ -- if Nothing, the current pages -- domain is used , cookSecure :: Maybe Bool -- ^Is this cookie secure?- , cookExpiry :: Maybe Integer -- ^Expiry date expressed as+ , cookExpiry :: Maybe Double -- ^Expiry date expressed as -- seconds since the Unix epoch -- Nothing indicates that the -- cookie never expires@@ -382,33 +380,33 @@ parseJSON v = typeMismatch "Cookie" v -- |Retrieve all cookies visible to the current page.-cookies :: WebDriver wd => wd [Cookie]+cookies :: (HasCallStack, 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 :: (HasCallStack, 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 :: (HasCallStack, WebDriver wd) => Cookie -> wd () deleteCookie c = noReturn $ doSessCommand methodDelete ("/cookie/" `append` urlEncode (cookName c)) Null -deleteCookieByName :: WebDriver wd => Text -> wd ()+deleteCookieByName :: (HasCallStack, 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 :: (HasCallStack, WebDriver wd) => wd () deleteVisibleCookies = noReturn $ doSessCommand methodDelete "/cookie" Null -- |Get the current page source-getSource :: WebDriver wd => wd Text+getSource :: (HasCallStack, WebDriver wd) => wd Text getSource = doSessCommand methodGet "/source" Null -- |Get the title of the current page.-getTitle :: WebDriver wd => wd Text+getTitle :: (HasCallStack, WebDriver wd) => wd Text getTitle = doSessCommand methodGet "/title" Null -- |Specifies element(s) within a DOM tree using various selection methods.@@ -438,100 +436,100 @@ 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 :: (HasCallStack, 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 :: (HasCallStack, WebDriver wd) => Selector -> wd [Element] findElems = doSessCommand methodPost "/elements" -- |Return the element that currently has focus.-activeElem :: WebDriver wd => wd Element+activeElem :: (HasCallStack, 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 :: (HasCallStack, 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 :: (HasCallStack, 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 :: (HasCallStack, 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 :: (HasCallStack, 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 :: (HasCallStack, 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 :: (HasCallStack, 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 +-- 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 :: (HasCallStack, 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]+sendRawKeys :: (HasCallStack, WebDriver wd) => Text -> wd ()+sendRawKeys t = noReturn . doSessCommand methodPost "/keys" . single "value" $ [t] -- |Return the tag name of the given element.-tagName :: WebDriver wd => Element -> wd Text+tagName :: (HasCallStack, 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 :: (HasCallStack, 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 :: (HasCallStack, 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 :: (HasCallStack, 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 :: (HasCallStack, 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 :: (HasCallStack, 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 :: (HasCallStack, 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 :: (HasCallStack, WebDriver wd) => Element -> wd (Float, Float) 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 :: (HasCallStack, WebDriver wd) => Element -> wd (Float, Float) 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+(<==>) :: (HasCallStack, 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+(</=>) :: (HasCallStack, WebDriver wd) => Element -> Element -> wd Bool e1 </=> e2 = not <$> (e1 <==> e2) -- |A screen orientation@@ -549,40 +547,40 @@ parseJSON v = typeMismatch "Orientation" v -- |Get the current screen orientation for rotatable display devices.-getOrientation :: WebDriver wd => wd Orientation+getOrientation :: (HasCallStack, WebDriver wd) => wd Orientation getOrientation = doSessCommand methodGet "/orientation" Null -- |Set the current screen orientation for rotatable display devices.-setOrientation :: WebDriver wd => Orientation -> wd ()+setOrientation :: (HasCallStack, WebDriver wd) => Orientation -> wd () setOrientation = noReturn . doSessCommand methodPost "/orientation" . single "orientation" -- |Get the text of an alert dialog.-getAlertText :: WebDriver wd => wd Text+getAlertText :: (HasCallStack, WebDriver wd) => wd Text getAlertText = doSessCommand methodGet "/alert_text" Null -- |Sends keystrokes to Javascript prompt() dialog.-replyToAlert :: WebDriver wd => Text -> wd ()+replyToAlert :: (HasCallStack, WebDriver wd) => Text -> wd () replyToAlert = noReturn . doSessCommand methodPost "/alert_text" . single "text" -- |Accepts the currently displayed alert dialog.-acceptAlert :: WebDriver wd => wd ()+acceptAlert :: (HasCallStack, WebDriver wd) => wd () acceptAlert = noReturn $ doSessCommand methodPost "/accept_alert" Null -- |Dismisses the currently displayed alert dialog.-dismissAlert :: WebDriver wd => wd ()+dismissAlert :: (HasCallStack, 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 :: (HasCallStack, 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 :: (HasCallStack, 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 :: (HasCallStack, WebDriver wd) => (Int, Int) -> Element -> wd () moveToFrom (x,y) (Element e) = noReturn . doSessCommand methodPost "/moveto" . triple ("element","xoffset","yoffset") $ (e,x,y)@@ -604,52 +602,52 @@ 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 :: (HasCallStack, 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 :: (HasCallStack, 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 :: (HasCallStack, WebDriver wd) => wd () mouseDown = noReturn $ doSessCommand methodPost "/buttondown" Null -- |Release the left mouse button.-mouseUp :: WebDriver wd => wd ()+mouseUp :: (HasCallStack, WebDriver wd) => wd () mouseUp = noReturn $ doSessCommand methodPost "/buttonup" Null -- |Double click at the current mouse location.-doubleClick :: WebDriver wd => wd ()+doubleClick :: (HasCallStack, 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 :: (HasCallStack, 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 :: (HasCallStack, 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 :: (HasCallStack, 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 :: (HasCallStack, 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 :: (HasCallStack, 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 :: (HasCallStack, WebDriver wd) => (Int, Int) -> Element -> wd () touchScrollFrom (x, y) (Element e) = noReturn . doSessCommand methodPost "/touch/scroll"@@ -657,14 +655,14 @@ $ (x, y, e) -- |Emulate a double click on a touch device.-touchDoubleClick :: WebDriver wd => Element -> wd ()+touchDoubleClick :: (HasCallStack, 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 :: (HasCallStack, WebDriver wd) => Element -> wd () touchLongClick (Element e) = noReturn . doSessCommand methodPost "/touch/longclick"@@ -672,14 +670,14 @@ -- |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 :: (HasCallStack, WebDriver wd) => (Int, Int) -> wd () touchFlick = noReturn . doSessCommand methodPost "/touch/flick" . pair ("xSpeed", "ySpeed") -- |Emulate a flick on the touch screen.-touchFlickFrom :: WebDriver wd =>+touchFlickFrom :: (HasCallStack, WebDriver wd) => Int -- ^ flick velocity -> (Int, Int) -- ^ a location relative to the given element -> Element -- ^ the given element@@ -694,23 +692,23 @@ ] -- |Get the current geographical location of the device.-getLocation :: WebDriver wd => wd (Int, Int, Int)+getLocation :: (HasCallStack, 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 :: (HasCallStack, 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 :: (HasCallStack, WebDriver wd) => FilePath -> wd () uploadFile path = uploadZipEntry =<< liftBase (readEntry [] path) -- |Uploads a raw bytestring with associated file info.-uploadRawFile :: WebDriver wd =>+uploadRawFile :: (HasCallStack, WebDriver wd) => FilePath -- ^File path to use with this bytestring. -> Integer -- ^Modification time -- (in seconds since Unix epoch).@@ -722,21 +720,21 @@ -- |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 :: (HasCallStack, 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 :: (HasCallStack, 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 :: (HasCallStack, 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 :: (HasCallStack, WebDriver wd) => WebStorageType -> wd () deleteAllKeys s = noReturn $ doStorageCommand methodDelete s "" Null -- |An HTML 5 storage type@@ -746,15 +744,15 @@ -- |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 :: (HasCallStack, 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 :: (HasCallStack, 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 :: (HasCallStack, 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.@@ -795,11 +793,11 @@ -- -- 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 :: (HasCallStack, 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 :: (HasCallStack, 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)
src/Test/WebDriver/Commands/Internal.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, GeneralizedNewtypeDeriving, ScopedTypeVariables #-} {-# OPTIONS_HADDOCK not-home #-} -- |Internal functions used to implement the functions exported by -- "Test.WebDriver.Commands". These may be useful for implementing non-standard@@ -17,17 +17,19 @@ ) where import Test.WebDriver.Class+import Test.WebDriver.JSON import Test.WebDriver.Session import Test.WebDriver.Utils (urlEncode) +import Control.Applicative+import Control.Exception.Lifted import Data.Aeson import Data.Aeson.Types+import Data.CallStack+import Data.Default.Class 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 @@ -36,7 +38,7 @@ deriving (Eq, Ord, Show, Read) instance FromJSON Element where- parseJSON (Object o) = Element <$> o .: "ELEMENT"+ parseJSON (Object o) = Element <$> (o .: "ELEMENT" <|> o .: "element-6066-11e4-a52e-4f735466cecf") parseJSON v = typeMismatch "Element" v instance ToJSON Element where@@ -66,7 +68,7 @@ -- 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) =>+doSessCommand :: (HasCallStack, WebDriver wd, ToJSON a, FromJSON b) => Method -> Text -> a -> wd b doSessCommand method path args = do WDSession { wdSessId = mSessId } <- getSession@@ -75,14 +77,21 @@ where msg = "doSessCommand: No session ID found for relative URL " ++ show path- Just (SessionId sId) -> doCommand method- (T.concat ["/session/", urlEncode sId, path]) args+ Just (SessionId sId) ->+ -- Catch BadJSON exceptions here, since most commands go through this function.+ -- Then, re-throw them with "error", which automatically appends a callstack+ -- to the message in modern GHCs.+ -- This callstack makes it easy to see which command caused the BadJSON exception,+ -- without exposing too many internals.+ catch+ (doCommand method (T.concat ["/session/", urlEncode sId, path]) args)+ (\(e :: BadJSON) -> error $ show e) -- |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) =>+doElemCommand :: (HasCallStack, 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@@ -91,7 +100,7 @@ -- 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) =>+doWinCommand :: (HasCallStack, 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
@@ -4,7 +4,7 @@ waitUntil, waitUntil' , waitWhile, waitWhile' -- * Expected conditions- , ExpectFailed, expect, unexpected+ , ExpectFailed (..), expect, unexpected , expectAny, expectAll , expectNotStale, expectAlertOpen , catchFailedCommand@@ -16,15 +16,16 @@ import Test.WebDriver.Exceptions import Test.WebDriver.Session +import Control.Concurrent+import Control.Exception.Lifted import Control.Monad.Base import Control.Monad.Trans.Control-import Control.Exception.Lifted-import Control.Concurrent -import Data.Time.Clock-import Data.Typeable+import Data.CallStack import qualified Data.Foldable as F import Data.Text (Text)+import Data.Time.Clock+import Data.Typeable #if !MIN_VERSION_base(4,6,0) || defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706 import Prelude hiding (catch)@@ -35,7 +36,7 @@ data ExpectFailed = ExpectFailed String deriving (Show, Eq, Typeable) -- |throws 'ExpectFailed'. This is nice for writing your own abstractions.-unexpected :: MonadBaseControl IO m =>+unexpected :: (MonadBaseControl IO m, HasCallStack) => String -- ^ Reason why the expected condition failed. -> m a unexpected = throwIO . ExpectFailed@@ -43,36 +44,36 @@ -- |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 :: (MonadBaseControl IO m, HasCallStack) => 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 :: (F.Foldable f, MonadBaseControl IO m, HasCallStack) => (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 :: (F.Foldable f, MonadBaseControl IO m, HasCallStack) => (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 :: (WebDriver wd, HasCallStack) => 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 :: (WebDriver wd, HasCallStack) => 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 :: (MonadBaseControl IO m, HasCallStack) => FailedCommandType -> m a -> m a catchFailedCommand t1 m = m `catch` handler- where - handler e@(FailedCommand t2 _) + where+ handler e@(FailedCommand t2 _) | t1 == t2 = unexpected . show $ e handler e = throwIO e @@ -81,29 +82,29 @@ -- '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 :: (WDSessionStateControl m, HasCallStack) => 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' :: (WDSessionStateControl m, HasCallStack) => 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 :: (WDSessionStateControl m, HasCallStack) => 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' :: (WDSessionStateControl m, HasCallStack) => 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) =>+waitEither :: (WDSessionStateControl m, HasCallStack) => ((String -> m b) -> String -> m b) -> ((String -> m b) -> a -> m b) -> Int -> Double -> m a -> m b@@ -120,7 +121,7 @@ handleExpectFailed (e :: ExpectFailed) = return . Left . show $ e -wait' :: (WDSessionStateIO m) =>+wait' :: (WDSessionStateIO m, HasCallStack) => ((String -> m b) -> m a -> m b) -> Int -> Double -> m a -> m b wait' handler waitAmnt t wd = waitLoop =<< liftBase getCurrentTime where@@ -143,7 +144,7 @@ -- -- > waitUntil 5 (getText <=< findElem $ ByCSS ".class") -- > `onTimeout` return ""-onTimeout :: MonadBaseControl IO m => m a -> m a -> m a+onTimeout :: (MonadBaseControl IO m, HasCallStack) => m a -> m a -> m a onTimeout m r = m `catch` handler where handler (FailedCommand Timeout _) = r
src/Test/WebDriver/Exceptions/Internal.hs view
@@ -1,10 +1,11 @@-{-# LANGUAGE OverloadedStrings, RecordWildCards, DeriveDataTypeable, ConstraintKinds, FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings, RecordWildCards, DeriveDataTypeable, ConstraintKinds, FlexibleContexts, NamedFieldPuns #-} module Test.WebDriver.Exceptions.Internal ( InvalidURL(..), HTTPStatusUnknown(..), HTTPConnError(..) , UnknownCommand(..), ServerError(..) , FailedCommand(..), failedCommand, mkFailedCommandInfo , FailedCommandType(..), FailedCommandInfo(..), StackFrame(..)+ , externalCallStack, callStackItemToStackFrame ) where import Test.WebDriver.Session import Test.WebDriver.JSON@@ -12,16 +13,17 @@ import Data.Aeson import Data.Aeson.Types (Parser, typeMismatch) import Data.ByteString.Lazy.Char8 (ByteString)+import Data.CallStack+import qualified Data.List as L import Data.Text (Text) import qualified Data.Text.Lazy.Encoding as TLE +import Control.Applicative 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 Data.Typeable (Typeable) import Prelude -- hides some "unused import" warnings @@ -124,19 +126,28 @@ -- |Constructs a FailedCommandInfo from only an error message.-mkFailedCommandInfo :: (WDSessionState s) => String -> s FailedCommandInfo-mkFailedCommandInfo m = do+mkFailedCommandInfo :: (WDSessionState s) => String -> CallStack -> s FailedCommandInfo+mkFailedCommandInfo m cs = do sess <- getSession- return $ FailedCommandInfo { errMsg = m + return $ FailedCommandInfo { errMsg = m , errSess = Just sess , errScreen = Nothing , errClass = Nothing- , errStack = [] }+ , errStack = fmap callStackItemToStackFrame cs } +-- |Use GHC's CallStack capabilities to return a callstack to help debug a FailedCommand.+-- Drops all stack frames inside Test.WebDriver modules, so the first frame on the stack+-- should be where the user called into Test.WebDriver+externalCallStack :: (HasCallStack) => CallStack+externalCallStack = dropWhile isWebDriverFrame callStack+ where isWebDriverFrame :: ([Char], SrcLoc) -> Bool+ isWebDriverFrame (_, SrcLoc {srcLocModule}) = "Test.WebDriver" `L.isPrefixOf` srcLocModule+ -- |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+failedCommand :: (HasCallStack, WDSessionStateIO s) => FailedCommandType -> String -> s a+failedCommand t m = do+ throwIO . FailedCommand t =<< mkFailedCommandInfo m externalCallStack -- |An individual stack frame from the stack trace provided by the server -- during a FailedCommand.@@ -179,3 +190,11 @@ reqStr :: Text -> Parser String reqStr k = req k >>= maybe (return "") return parseJSON v = typeMismatch "StackFrame" v+++callStackItemToStackFrame :: (String, SrcLoc) -> StackFrame+callStackItemToStackFrame (functionName, SrcLoc {..}) = StackFrame { sfFileName = srcLocFile+ , sfClassName = srcLocModule+ , sfMethodName = functionName+ , sfLineNumber = srcLocStartLine+ }
src/Test/WebDriver/Internal.hs view
@@ -16,23 +16,24 @@ 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 Network.HTTP.Types.Header+import Network.HTTP.Types.Status (Status(..)) +import qualified Data.ByteString.Base64.Lazy as B64+import qualified Data.ByteString.Char8 as BS+import Data.ByteString.Lazy.Char8 (ByteString)+import Data.ByteString.Lazy.Char8 as LBS (unpack, null)+import qualified Data.ByteString.Lazy.Internal as LBS (ByteString(..))+import Data.CallStack 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 Control.Exception.Lifted (throwIO)+import Control.Monad.Base import Data.String (fromString) import Data.Word (Word8)@@ -48,7 +49,7 @@ 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)@@ -73,7 +74,7 @@ , requestHeaders = wdSessRequestHeaders ++ [ (hAccept, "application/json;charset=UTF-8") , (hContentType, "application/json;charset=UTF-8") ]- , method = meth + , method = meth #if !MIN_VERSION_http_client(0,5,0) , checkStatus = \_ _ _ -> Nothing #endif@@ -88,7 +89,7 @@ , histResponse = tryRes , histRetryCount = nRetries }- putSession s { wdSessHist = wdSessHistUpdate h wdSessHist } + putSession s { wdSessHist = wdSessHistUpdate h wdSessHist } return tryRes retryOnTimeout :: Int -> IO a -> IO (Int, (Either SomeException a))@@ -103,31 +104,31 @@ #else | Just HTTPClient.ResponseTimeout <- fromException e #endif- , maxRetry > nRetries + , 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 :: (HasCallStack, 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 = + | code >= 500 && code < 600 = case lookup hContentType headers of Just ct | "application/json" `BS.isInfixOf` ct ->- parseJSON' + parseJSON' (maybe body fromStrict $ lookup "X-Response-Body-Start" headers) >>= handleJSONErr >>= maybe returnNull returnErr- | otherwise -> + | otherwise -> returnHTTPErr ServerError Nothing -> returnHTTPErr (ServerError . ("HTTP response missing content type. Server reason was: "++))- --redirect case (used as a response to createSession requests) + --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@@ -138,12 +139,12 @@ -- No Content response | code == 204 = returnNull -- HTTP Success- | code >= 200 && code < 300 = + | code >= 200 && code < 300 = if LBS.null body then returnNull else do- rsp@WDResponse {rspVal = val} <- parseJSON' body - handleJSONErr rsp >>= maybe + rsp@WDResponse {rspVal = val} <- parseJSON' body+ handleJSONErr rsp >>= maybe (handleRespSessionId rsp >> Right <$> fromJSON' val) returnErr -- other status codes: return error@@ -157,11 +158,11 @@ --HTTP response variables code = statusCode status reason = BS.unpack $ statusMessage status- status = responseStatus r - body = responseBody r + status = responseStatus r+ body = responseBody r headers = responseHeaders r -handleRespSessionId :: (WDSessionStateIO s) => WDResponse -> s ()+handleRespSessionId :: (HasCallStack, WDSessionStateIO s) => WDResponse -> s () handleRespSessionId WDResponse{rspSessId = sessId'} = do sess@WDSession { wdSessId = sessId} <- getSession case (sessId, (==) <$> sessId <*> sessId') of@@ -171,15 +172,18 @@ (_, 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 :: (HasCallStack, 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+ seleniumStack = errStack errInfo errInfo' = errInfo { errSess = Just sess- , errScreen = screen }+ -- Append the Haskell stack frames to the ones returned from Selenium+ , errScreen = screen+ , errStack = seleniumStack ++ (fmap callStackItemToStackFrame externalCallStack) } e errType = toException $ FailedCommand errType errInfo' return . Just $ case status of 7 -> e NoSuchElement@@ -211,7 +215,7 @@ -- |Internal type representing the JSON response object-data WDResponse = WDResponse { +data WDResponse = WDResponse { rspSessId :: Maybe SessionId , rspStatus :: Word8 , rspVal :: Value@@ -223,5 +227,3 @@ <*> o .: "status" <*> o .:?? "value" .!= Null parseJSON v = typeMismatch "WDResponse" v--
webdriver.cabal view
@@ -1,5 +1,5 @@ Name: webdriver-Version: 0.8.5+Version: 0.9 Cabal-Version: >= 1.10 License: BSD3 License-File: LICENSE@@ -66,7 +66,8 @@ , exceptions >= 0.4 , scientific >= 0.2 , data-default-class- + , call-stack+ if flag(network-uri) build-depends: network-uri >= 2.6, network >= 2.6 else