├── .ghci ├── .gitignore ├── .travis.yml ├── CHANGELOG.md ├── LICENSE ├── README.md ├── ROADMAP.md ├── Setup.hs ├── app ├── Main.lhs ├── ParallelStressTest.hs ├── ReplDemo.hs └── TastyDemo.lhs ├── code-of-conduct.md ├── dev ├── doc.md ├── run-demo.sh ├── run-parallel-stress-test.sh ├── run-tests.sh └── test-compat.sh ├── doc ├── TastyDemo.md └── Tutorial.md ├── makefile ├── src ├── Test │ └── Tasty │ │ ├── WebDriver.hs │ │ └── WebDriver │ │ └── Config.hs └── Web │ └── Api │ ├── WebDriver.hs │ └── WebDriver │ ├── Assert.hs │ ├── Classes.hs │ ├── Endpoints.hs │ ├── Helpers.hs │ ├── Monad.hs │ ├── Types.hs │ ├── Types │ └── Keyboard.hs │ └── Uri.hs ├── stack.yaml ├── test ├── Main.hs ├── Test │ └── Tasty │ │ └── WebDriver │ │ └── Config │ │ └── Test.hs ├── Web │ └── Api │ │ └── WebDriver │ │ ├── Assert │ │ └── Test.hs │ │ ├── Monad │ │ ├── Test.hs │ │ └── Test │ │ │ ├── Server.hs │ │ │ ├── Server │ │ │ ├── Page.hs │ │ │ └── State.hs │ │ │ └── Session │ │ │ ├── InvalidElementState.hs │ │ │ ├── Success.hs │ │ │ └── UnknownError.hs │ │ └── Types │ │ └── Test.hs └── page │ ├── invalidElementState.html │ ├── stdin.txt │ └── success.html └── webdriver-w3c.cabal /.ghci: -------------------------------------------------------------------------------- 1 | :set prompt "\x03BB: " 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | dist-* 3 | cabal-dev 4 | *.o 5 | *.hi 6 | *.chi 7 | *.chs.h 8 | *.dyn_o 9 | *.dyn_hi 10 | .hpc 11 | .hsenv 12 | .cabal-sandbox/ 13 | cabal.sandbox.config 14 | *.prof 15 | *.aux 16 | *.hp 17 | *.eventlog 18 | .stack-work/ 19 | cabal.project.local 20 | .HTF/ 21 | stack.yaml.lock 22 | 23 | .DS_Store 24 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # Use new container infrastructure to enable caching 2 | sudo: false 3 | 4 | 5 | # Do not choose a language; we provide our own build tools. 6 | language: generic 7 | 8 | 9 | # Caching so the next build will be fast too. 10 | cache: 11 | directories: 12 | - $HOME/.stack 13 | - $HOME/.stack-work 14 | 15 | 16 | # Ensure necessary system libraries are present 17 | addons: 18 | apt: 19 | sources: 20 | - google-chrome 21 | packages: 22 | - google-chrome-stable 23 | - libgmp-dev 24 | - unzip 25 | - xvfb 26 | 27 | 28 | before_install: 29 | - mkdir -p ~/.local/bin 30 | - export PATH=$HOME/.local/bin:$PATH 31 | - 32 | - # install stack 33 | - travis_retry curl -L https://get.haskellstack.org/stable/linux-x86_64.tar.gz | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' 34 | - 35 | - # install geckodriver 36 | - travis_retry curl -L https://github.com/mozilla/geckodriver/releases/download/v0.29.0/geckodriver-v0.29.0-linux64.tar.gz | tar xz -C ~/.local/bin 37 | - 38 | - # install chromedriver 39 | - wget -O /tmp/chromedriver.zip https://chromedriver.storage.googleapis.com/89.0.4389.23/chromedriver_linux64.zip 40 | - unzip /tmp/chromedriver.zip chromedriver -d ~/.local/bin 41 | - 42 | - # install firefox 43 | - wget -L -O firefox.tar.bz2 'https://download.mozilla.org/?product=firefox-latest-ssl&os=linux64&lang=en-US' 44 | - tar xvf firefox.tar.bz2 -C ~/.local/bin 45 | - export PATH=$HOME/.local/bin/firefox:$PATH 46 | - 47 | - # start remote ends 48 | - export MOZ_HEADLESS=1 49 | - export WD_STRESS_TEST_NUM_TESTS="50" 50 | - xvfb-run -a geckodriver --binary $HOME/.local/bin/firefox/firefox --marionette-port 2828 --port 4444 --log error >/dev/null 2>/dev/null & 51 | - xvfb-run -a geckodriver --binary $HOME/.local/bin/firefox/firefox --marionette-port 2829 --port 4445 --log error >/dev/null 2>/dev/null & 52 | - xvfb-run -a geckodriver --binary $HOME/.local/bin/firefox/firefox --marionette-port 2830 --port 4446 --log error >/dev/null 2>/dev/null & 53 | - xvfb-run -a geckodriver --binary $HOME/.local/bin/firefox/firefox --marionette-port 2831 --port 4447 --log error >/dev/null 2>/dev/null & 54 | - xvfb-run -a geckodriver --binary $HOME/.local/bin/firefox/firefox --marionette-port 2832 --port 4448 --log error >/dev/null 2>/dev/null & 55 | - chromedriver --port=9515 & 56 | - chromedriver --port=9516 & 57 | - sleep 2 58 | 59 | 60 | install: 61 | - # stack --no-terminal --install-ghc test --only-dependencies 62 | 63 | 64 | before_script: 65 | - # root needs permission to run chrome-sandbox; else chromedriver will error out 66 | - sudo chown root /opt/google/chrome/chrome-sandbox 67 | - sudo chmod 4755 /opt/google/chrome/chrome-sandbox 68 | 69 | 70 | script: 71 | - stack --no-terminal test --haddock --no-haddock-deps 72 | - stack --no-terminal install webdriver-w3c:wd-parallel-stress-test && stack --no-terminal exec -- wd-parallel-stress-test --wd-remote-ends 'geckodriver https://localhost:4444 https://localhost:4445 https://localhost:4446 https://localhost:4447 https://localhost:4448' --num-threads 5 73 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | Changelog for webdriver-w3c 2 | =========================== 3 | 4 | Unreleased 5 | ---------- 6 | 7 | 0.0.3 8 | ----- 9 | 10 | * Added 11 | * `MonadIO` and `MonadFail` instances for `WebDriverTT t eff` 12 | * New endpoints: `newWindow`, `getComputedRole`, `getComputedLabel`, `printPage` 13 | * Compiles with aeson >=2.0.0.0 and GHC >=8.8.1 14 | * Changed 15 | * The old behavior of `runIsolated` has been renamed to `runIsolated_`, and `runIsolated` now returns the result of its argument. The naming is meant to mimic the `sequence_`/`sequence` pattern. 16 | * `chromeOptions` renamed to `goog:chromeOptions` in `ToJSON` `FromJSON` instances for `Capability` for compatibility with chromedriver versions >=75; see https://chromedriver.storage.googleapis.com/75.0.3770.8/notes.txt. Fixes issue #21. 17 | * Fixed 18 | * Bug in behavior of `switchToFrame` when using `FrameContainingElement` 19 | * Default value of wd-private-mode tasty flag changed to `False` 20 | 21 | 22 | 23 | 0.0.2 24 | ----- 25 | 26 | This version introduces significant changes to the API, prompted by changes in the `script-monad` dependency. The main change is that `WebDriver` and `WebDriverT` have been replaced by `WebDriverT` and `WebDriverTT` and are a more sensible monad transformer and monad transformer transformer, respectively. The main effect of this is that (1) `WebDriver*` types take an extra parameter for the effect monad, and (2) functions for working with `WebDriver*` now have additional `Monad` and `MonadTrans` constraints. The library will now only compile with GHC >=8.6 due to a transitive dependency on `QuantifiedConstraints`. 27 | 28 | * Added 29 | * Browser preferences field on `FirefoxOptions` and `ChromeOptions` 30 | * `readDataFile`, `writeDataFile`, `readJsonFile`, and `writeJsonFile` data helpers 31 | * `breakpoint` and `breakpointWith` for helping with debugging; controlled by `breakpointsOn`, and `breakpointsOff` 32 | * `expectIs` 33 | * Changed 34 | * Switched order of arguments for `elementSendKeys`, `getElementAttribute`, `getElementProperty`, and `getElementCssValue`. The element reference now comes last to make it easier to chain these with `>>=`. 35 | * `logDebug` and `logNotice` 36 | * Tested on geckodriver 0.23.0. 37 | * Fixed 38 | * Bug in behavior of `cleanupOnError` was causing it to miss some errors, which left the remote end session open 39 | 40 | 41 | 42 | 0.0.1 43 | ----- 44 | 45 | * Added 46 | * `WebDriver` monad for remotely controlling user agents. Also comes in monad transformer flavor with `WebDriverT` 47 | * Bindings for all [WebDriver endpoints](https://w3c.github.io/webdriver/webdriver-spec.html) as of 2018-04-20 48 | * Integration with the [Tasty](https://hackage.haskell.org/package/tasty) test framework 49 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | webdriver-w3c 2 | ============= 3 | 4 | [![Build Status](https://travis-ci.org/nbloomf/webdriver-w3c.svg?branch=master)](https://travis-ci.org/nbloomf/webdriver-w3c) 5 | 6 | Haskell bindings for the W3C WebDriver API. 7 | 8 | 9 | What is it? 10 | ----------- 11 | 12 | `webdriver-w3c` is a Haskell library providing bindings to the WebDriver API, enabling us to write Haskell programs that control web browsers. It is actively tested against `geckodriver` and `chromedriver`, as well as a fake remote end implementation. It is implemented as a monad transformer. 13 | 14 | Also included is an integration with the [tasty](https://hackage.haskell.org/package/tasty) test framework. 15 | 16 | Note that this library requires GHC >=8.6 due to a transitive dependency on `QuantifiedConstraints`. 17 | 18 | [WebDriver](https://www.w3.org/TR/webdriver/) is an HTTP API for interacting with a web browser remotely. It is on track to become a W3C specification and based on work done by the [Selenium](https://www.seleniumhq.org/) community. 19 | 20 | 21 | Who is it for? 22 | -------------- 23 | 24 | If you: 25 | 26 | * Are interested in browser automation, especially for testing, 27 | * Want to write browser automation code in Haskell, and 28 | * Don't mind filing bug and feature requests, 29 | 30 | then you might give `webdriver-w3c` a try. 31 | 32 | This library is unrelated to [webdriver](http://hackage.haskell.org/package/webdriver) except in spirit. That library is older and more mature, and depending on your needs may be more appropriate. 33 | 34 | 35 | Where is the documentation? 36 | --------------------------- 37 | 38 | Depends on what you want! 39 | 40 | * _A cursory glance:_ This brief [tutorial](https://github.com/nbloomf/webdriver-w3c/blob/master/doc/Tutorial.md) shows how to go from nothing to one very simple test. 41 | * _To start a simple project:_ If you want to write a test suite, there's a separate tutorial on using the [tasty integration](https://github.com/nbloomf/webdriver-w3c/blob/master/doc/TastyDemo.md). 42 | * _To dig into the API:_ The API docs are on [Hackage](https://hackage.haskell.org/package/webdriver-w3c). 43 | * _To mess with the library code:_ There's a very small amount of [developer documentation](https://github.com/nbloomf/webdriver-w3c/blob/master/dev/doc.md); I'm also happy to answer questions. 44 | 45 | 46 | Who is responsible for this? 47 | ---------------------------- 48 | 49 | Nathan Bloomfield (@nbloomf) wrote and maintains the code. 50 | 51 | Other contributors, in lexicographic order: 52 | 53 | * Ivan Enderlin (@hywan) 54 | 55 | And users like you! 56 | 57 | Also thanks to my employer for allowing -- actually, requiring :) -- this to be open source. 58 | 59 | And special thanks to Jonathan Lipps' [Simplified Guide](https://github.com/jlipps/simple-wd-spec) to the WebDriver spec. 60 | -------------------------------------------------------------------------------- /ROADMAP.md: -------------------------------------------------------------------------------- 1 | todo 2 | ==== 3 | * Handle IO (& other) errors in cleanup helper 4 | 5 | 6 | next 7 | ==== 8 | * artifact directory; use adjustoption in the testcase builders, with an extra argument 9 | for the directory name, to describe a hierarchy for saving test artifacts (stdout, logs, 10 | screenshots) and also getting mocked input (stdin, reference screenshots, etc). 11 | con: need to specify both 12 | directory name and human readable test name. will need a type for directory names; 13 | use overloadedstrings and throw an error if it has bad chars. don't clobber old 14 | artifact directories; put each in a separate dir with e.g. timestamp in the name 15 | provide an option for building the directory structure without running the tests. 16 | This has the advantage of giving a standardized structure to test artifacts for review. 17 | will need an option for the root artifact directory. e.g. 18 | 19 | ``` 20 | root_artifact_dir 21 | +> run_1970_01_01_00_00_00 22 | | +> test_artifact_hierarchy 23 | | 24 | +> run_1970_01_01_01_00_00 25 | +> test_artifact_hierarchy 26 | ``` 27 | 28 | 29 | someday 30 | ======= 31 | * Chromedriver compatibility: several tests are ignored for chromedriver due to spec-noncompliance. Some of these can be fixed -- notably the findElement tests -- by figuring out how to interpret chromedriver's responses. 32 | * /session/{session id}/element/{element id}/displayed 33 | * Need a ci test matrix, but have to think about how to prevent combinatorial blowup; dependencies are geckodriver+firefox+chromedriver+chrome, so matrix will get big fast. Compromise: only support one version of the drivers at a time? 34 | 35 | 36 | Notes on ignored tests 37 | - getAlertText on headless geckodriver 38 | https://bugzilla.mozilla.org/show_bug.cgi?id=1460857 39 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /app/Main.lhs: -------------------------------------------------------------------------------- 1 | Getting Started with `webdriver-w3c` 2 | ------------------------------------ 3 | 4 | Hello, and welcome to the wonderful world of browser automation with WebDriver and Haskell! This module is a brief tutorial on how we can use use the `webdriver-w3c` library to write Haskell programs that interact with web pages just like a person would. If you need to test a web application, or want to automate some web thing that curl and wget alone can't handle easily, you might find this mildly interesting, maybe. 5 | 6 | (This text is a literate program, so we have to start with some compiler noises. Nothing to see here!) 7 | 8 | > {-# LANGUAGE OverloadedStrings #-} 9 | > module Main where 10 | > 11 | > import Web.Api.WebDriver 12 | > import Test.Tasty.WebDriver 13 | > 14 | > import Test.Tasty 15 | > import Control.Monad.Trans.Class 16 | > import qualified System.Environment as SE 17 | > import Control.Monad 18 | > import System.IO 19 | > 20 | > main :: IO () 21 | > main = return () 22 | 23 | 24 | 25 | Prerequisites 26 | ------------- 27 | 28 | To follow along, you're going to need a few things. 29 | 30 | 1. [Stack](https://docs.haskellstack.org/en/stable/README/). Stack is a build tool for Haskell projects. It compiles our programs, runs tests, processes documentation, generates code coverage reports, and keeps project dependencies under control. 31 | 2. A copy of this repository 32 | 3. A web browser; this tutorial assumes you're using Firefox. 33 | 4. A WebDriver proxy server for your browser. For Firefox this is [geckodriver](https://github.com/mozilla/geckodriver). Don't sweat it if you don't know what "WebDriver proxy server" means right now, we'll get to that. 34 | 35 | Next, start your proxy server. For geckodriver on unix-like OSs, that is done with the `geckodriver &` command. You should see a line that looks something like this: 36 | 37 | 1521524046173 geckodriver INFO Listening on 127.0.0.1:4444 38 | 39 | Leave that program running. Just leave it alone. 40 | 41 | Finally, in another shell window, navigate to the directory holding this repo and say 42 | 43 | stack ghci webdriver-w3c:webdriver-w3c-intro 44 | 45 | Well, don't *say* that, out loud. Type it. :) This might take a while the first time while stack downloads the compiler and libraries it needs. When it finishes, this command opens a Haskell interpreter with `webdriver-w3c` loaded so we can play with it. You'll know everything is okay if you see a line like 46 | 47 | Ok, one module loaded. 48 | 49 | followed by a `λ:` prompt. To be sure, try typing in `return` and then hit (enter). If you see this scary error message: 50 | 51 | :1:1: error: 52 | • No instance for (Show (a0 -> m0 a0)) 53 | arising from a use of ‘print’ 54 | (maybe you haven't applied a function to enough arguments?) 55 | • In a stmt of an interactive GHCi command: print it 56 | 57 | then everything is working great! 58 | 59 | 60 | 61 | My First Browser Automation 62 | --------------------------- 63 | 64 | Ok! You've got your WebDriver proxy (geckodriver) running in one terminal window, and ghci running in another. Let's start with a simple example to illustrate what we can do, then explain how it works. Read this code block, even if the syntax is meaningless. 65 | 66 | > do_a_barrel_roll :: WebDriverT IO () 67 | > do_a_barrel_roll = do 68 | > fullscreenWindow 69 | > navigateTo "https://www.google.com" 70 | > performActions [typeString "do a barrel roll"] 71 | > performActions [press EnterKey] 72 | > wait 5000000 73 | > return () 74 | 75 | Without running that code -- and maybe without being proficient in Haskell -- what do you think it does? 76 | 77 | Now let's run it. In the interpreter, type 78 | 79 | example1 80 | 81 | followed by (enter). You should see a Firefox window open, go fullscreen, and search Google for "do a barrel roll". 82 | 83 | `example1`, by the way, is this: 84 | 85 | > example1 :: IO () 86 | > example1 = do 87 | > execWebDriverT defaultWebDriverConfig 88 | > (runIsolated_ defaultFirefoxCapabilities do_a_barrel_roll) 89 | > return () 90 | 91 | Let's break down what just happened. 92 | 93 | 1. `do_a_barrel_roll` is a *WebDriver session*, expressed in the `WebDriver` DSL. It's a high-level description for a sequence of browser actions: in this case, "make the window full screen", "navigate to google.com", and so on. 94 | 2. `runIsolated_` takes a WebDriver session and runs it in a fresh browser instance. The parameters of this instance are specified in `defaultFirefoxCapabilities`. 95 | 3. `execWebDriver` takes a WebDriver session and carries out the steps, using some options specified in `defaultWebDriverConfig`. 96 | 97 | You probably also noticed a bunch of noise got printed to your terminal starting with something like this: 98 | 99 | λ: example1 100 | 2018-06-23 15:19:46 Request POST http://localhost:4444/session 101 | { 102 | "capabilities": { 103 | "alwaysMatch": { 104 | "browserName": "firefox" 105 | } 106 | }, 107 | "desiredCapabilities": { 108 | "browserName": "firefox" 109 | } 110 | } 111 | 2018-06-23 15:19:48 Response 112 | { 113 | "value": { 114 | "sessionId": "383edca7-3054-0544-8c1e-cc64099462de", 115 | "capabilities": { 116 | "moz:webdriverClick": true, 117 | "platformVersion": "17.4.0", 118 | "moz:headless": false, 119 | "moz:useNonSpecCompliantPointerOrigin": false, 120 | "browserVersion": "60.0.2", 121 | "rotatable": false, 122 | "pageLoadStrategy": "normal", 123 | "moz:profile": "/var/folders/td/sxyy9wl919740vddr49g8nth0000gn/T/rust_mozprofile.aleh5JscOwwI", 124 | "moz:accessibilityChecks": false, 125 | "moz:processID": 88470, 126 | "platformName": "darwin", 127 | "timeouts": { 128 | "implicit": 0, 129 | "script": 30000, 130 | "pageLoad": 300000 131 | }, 132 | "acceptInsecureCerts": false, 133 | "browserName": "firefox" 134 | } 135 | } 136 | } 137 | 138 | This is the log. WebDriver sessions keep track of a bunch of info to help with debugging, like all requests and responses and all raised errors. By default the logs are printed to stderr but this is configurable. 139 | 140 | So what can you do in a WebDriver session? Not much -- but this is by design. The library includes: 141 | 142 | * A binding for each endpoint in the WebDriver spec 143 | * Some basic functions for reading and writing files, reading and writing at the console, and making arbitrary HTTP requests 144 | 145 | This plus Haskell's `do` notation make for a tidy EDSL for running browsers. Notably, a `WebDriver` session cannot do arbitrary `IO` by default, and `WebDriver` sessions are pure values. (There is an escape hatch for this restriction.) 146 | 147 | 148 | 149 | Behind the Scenes 150 | ----------------- 151 | 152 | WebDriver is an HTTP API for controlling web browsers like a human user would. In principle a browser could implement this API directly. In practice the major browsers have their own internally maintained APIs for automation and use a *proxy server* to translate between WebDriver and their internal API. 153 | 154 | This is the role geckodriver is playing in our examples so far: deep down, our code is making HTTP requests to geckodriver, and geckodriver is passing these requests on to Firefox. 155 | 156 | This library is also tested against Chrome via chromedriver. To do that, using `chromedriver`'s default settings, we need to make a couple of adjustments to the examples: replace 157 | 158 | defaultWebDriverConfig 159 | 160 | by 161 | 162 | defaultWebDriverConfig 163 | { _environment = defaultWebDriverEnvironment 164 | { _env = defaultWDEnv 165 | { _remotePort = 9515 166 | } 167 | } 168 | } 169 | 170 | and replace 171 | 172 | defaultFirefoxCapabilities 173 | 174 | by 175 | 176 | defaultChromeCapabilities 177 | 178 | (By the way - `defaultWebDriverConfig` has type `WebDriverConfig`, and includes knobs for tweaking almost everything about how our sessions run.) 179 | 180 | 181 | 182 | Making Assertions 183 | ----------------- 184 | 185 | It's expected that you're probably interested in using browser automation to run end-to-end tests on some web application -- and `webdriver-w3c` has some extra bits built in to make this simpler. 186 | 187 | In addition to the usual browser action commands, you can sprinkle your `WebDriver` sessions with *assertions*. Here's an example. 188 | 189 | > what_page_is_this :: (Monad eff) => WebDriverT eff () 190 | > what_page_is_this = do 191 | > navigateTo "https://www.google.com" 192 | > title <- getTitle 193 | > assertEqual title "Welcome to Lycos!" "Making sure we're at the lycos homepage" 194 | > return () 195 | 196 | Note the signature: `(Monad eff) => WebDriverT eff ()` instead of `WebDriverT IO ()`. What's happening here is that `WebDriverT` is a transformer over a monad `eff` within which a restricted set of effects (like writing to files and making HTTP requests) take place. These effects are "run" by an explicit evaluator that, for the default configuration, happens to use `IO`, but both the effect monad and the evaluator are configurable. By swapping out `IO` for another type we can, for example, run our tests against a mock Internet, and swapping out the evaluator we might have a "dry run" evaluator that doesn't actually do anything, but logs what it would have done. It's good practice to make our `WebDriver` code maximally flexible by using an effect parameter like `eff` instead of the concrete `IO` unless there's a good reason not to. 197 | 198 | Anyway, back to the example. What do you think this code does? Let's try it: type 199 | 200 | example2 201 | 202 | in the interpreter. You should see a browser window open briefly to google.com, with a scary "Invalid Assertion" message in the interpreter. `assertEqual` is the assertion statement: it takes two things (strings in this case) and checks whether they are equal. Shocking, hm? The third argument to `assertEqual` is a *comment*, so we can include some human readable info as to *why* this assertion was made. 203 | 204 | This is `example2`: 205 | 206 | > example2 :: IO () 207 | > example2 = do 208 | > (_, result) <- debugWebDriverT defaultWebDriverConfig 209 | > (runIsolated_ defaultFirefoxCapabilities what_page_is_this) 210 | > printSummary result 211 | > return () 212 | 213 | Here's what happened: 214 | 215 | 1. `what_page_is_this` is a WebDriver session, just like `do_a_barrel_roll`, this time including an assertion: that the title of some web page is "Welcome to Lycos!". 216 | 2. `runIsolated_` runs `what_page_is_this` in a fresh browser instance. 217 | 3. `debugWebDriver` works much like `execWebDriver`, except that it collects the results of any assertion statements and summarizes them (this is `result`). 218 | 4. `printSummary` takes the assertion results and prints them out all pretty like. 219 | 220 | Documentation on assertions is on [Hackage](https://hackage.haskell.org/package/webdriver-w3c-0.0.1/docs/Web-Api-WebDriver-Assert.html). 221 | 222 | 223 | 224 | Suites of Tests 225 | --------------- 226 | 227 | Alright. If you're writing e2e tests, you probably want to write a *lot* of e2e tests. In this case, we'd like our tests to be modular, isolated, and well-organized, so that when things go wrong we can quickly diagnose what happened. For this, `webdriver-w3c` integrates with the [tasty](https://hackage.haskell.org/package/tasty) test framework -- just import `Test.Tasty.WebDriver`. 228 | 229 | Suppose we've got two WebDriver tests. These are pretty dweeby just for illustration's sake. 230 | 231 | > back_button :: (Monad eff) => WebDriverT eff () 232 | > back_button = do 233 | > navigateTo "https://www.google.com" 234 | > navigateTo "https://wordpress.com" 235 | > goBack 236 | > title <- getTitle 237 | > assertEqual title "Google" "Behavior of 'back' button from WordPress homepage" 238 | > return () 239 | > 240 | > refresh_page :: (Monad eff) => WebDriverT eff () 241 | > refresh_page = do 242 | > navigateTo "https://www.mozilla.org" 243 | > pageRefresh 244 | > title <- getTitle 245 | > assertEqual title "Mozilla's Epic HomePage on the Internets" 246 | > "Refresh mozilla.org" 247 | > return () 248 | 249 | We can organize them into a hierarchy of tests like so. 250 | 251 | > test_suite :: TestTree 252 | > test_suite = testGroup "All Tests" 253 | > [ testCase "Back Button" back_button 254 | > , testCase "Refresh" refresh_page 255 | > ] 256 | 257 | Try running the suite with 258 | 259 | example3 260 | 261 | in the interpreter. Here's what `example3` looks like: 262 | 263 | > example3 :: IO () 264 | > example3 = do 265 | > SE.setEnv "TASTY_NUM_THREADS" "1" 266 | > defaultWebDriverMain 267 | > $ localOption (SilentLog) 268 | > $ localOption (PrivateMode True) 269 | > $ test_suite 270 | 271 | Here's what happened: 272 | 273 | 1. `test_suite` is a Tasty tree of individual `WebDriverT` test cases. 274 | 2. `defaultWebDriverMain` is a Tasty function that runs test trees. In this case we've also used `localOption` to tweak how the tests run -- in this case suppressing the usual session log output and running the browser in private mode. 275 | 276 | Tasty gave us lots of nice things for free, like pretty printing test results and timings. 277 | 278 | λ: example3 279 | >>> Deployment environment is DEV 280 | >>> Logging with colors 281 | All Tests 282 | Back Button: OK (7.23s) 283 | 1 assertion(s) 284 | Refresh: FAIL (4.29s) 285 | Invalid Assertion 286 | assertion: "Internet for people, not profit \8212 Mozilla" is equal to "Mozilla's Epic HomePage on the Internets" 287 | comment: Refresh mozilla.org 288 | 289 | 1 out of 2 tests failed (11.53s) 290 | 291 | Other test case constructors and test options are available; see [Hackage](https://hackage.haskell.org/package/webdriver-w3c-0.0.1/docs/Test-Tasty-WebDriver.html) for the details. 292 | 293 | The test suite for `webdriver-w3c` itself uses the Tasty integration. There is also a function, `checkWebDriver`, that can be used to build tests with QuickCheck, if you don't find that idea abominable. :) 294 | 295 | 296 | 297 | We need more power! 298 | ------------------- 299 | 300 | The vanilla `WebDriverT` is designed to help you control a browser with _batteries included_, but it has limitations. It can't possibly anticipate all the different ways you might want to control your tests, and it can't do arbitrary `IO`. But we have a powerful and very general escape hatch: the `WebDriverT` monad transformer is a special case of the `WebDriverTT` monad transformer _transformer_. 301 | 302 | The actual definition of `WebDriver` is 303 | 304 | type WebDriverT eff a = WebDriverTT IdentityT eff a 305 | 306 | where `IdentityT` is the _inner monad transformer_. By swapping out `IdentityT` for another transformer we can add more features specific to our application. 307 | 308 | Here's a typical example. Say you're testing a site with two deployment tiers -- "test" and "production". For the most part the same test suite should run against both tiers, but there are minor differences. Say the base URLs are slightly different; maybe production lives at `example.com` while test lives at `test.example.com`. Also while developing a new feature some parts of the test suite should only run on the test tier, maybe controlled by a feature flag. 309 | 310 | What we need is some extra read-only state to pass around. We can do this with a `ReaderT` transformer. To avoid adding a dependency on a whole transformer library, lets roll our own: 311 | 312 | > data ReaderT r eff a = ReaderT 313 | > { runReaderT :: r -> eff a 314 | > } 315 | > 316 | > instance (Monad eff) => Monad (ReaderT r eff) where 317 | > return x = ReaderT $ \_ -> return x 318 | > 319 | > x >>= f = ReaderT $ \r -> do 320 | > a <- runReaderT x r 321 | > runReaderT (f a) r 322 | > 323 | > instance (Monad eff) => Applicative (ReaderT r eff) where 324 | > pure = return 325 | > (<*>) = ap 326 | > 327 | > instance (Monad eff) => Functor (ReaderT r eff) where 328 | > fmap f x = x >>= (return . f) 329 | > 330 | > instance MonadTrans (ReaderT r) where 331 | > lift x = ReaderT $ \_ -> x 332 | > 333 | > reader :: (Monad eff) => (r -> a) -> ReaderT r eff a 334 | > reader f = ReaderT $ \r -> return $ f r 335 | 336 | Now our actual state might look something like this: 337 | 338 | > data MyEnv = MyEnv 339 | > { tier :: Tier 340 | > , featureFlag :: Bool 341 | > } 342 | > 343 | > data Tier = Test | Production 344 | > 345 | > env :: Tier -> MyEnv 346 | > env t = MyEnv 347 | > { tier = t 348 | > , featureFlag = False 349 | > } 350 | 351 | And we can augment `WebDriverTT` with our reader transformer. 352 | 353 | > type MyWebDriverT eff a = WebDriverTT (ReaderT MyEnv) eff a 354 | 355 | Now we can build values in `MyWebDriver` using the same API as before, using the extra features of the inner monad with `liftWebDriverTT`. 356 | 357 | > custom_environment :: (Monad eff) => MyWebDriverT eff () 358 | > custom_environment = do 359 | > theTier <- liftWebDriverTT $ reader tier 360 | > case theTier of 361 | > Test -> navigateTo "http://google.com" 362 | > Production -> navigateTo "http://yahoo.com" 363 | 364 | To actually run sessions using our custom monad stack we need to make a few adjustments. First, we use `execWebDriverTT` instead of `execWebDriverT`. 365 | 366 | Second, we need to supply a function that "runs" the inner transformer (in this case `ReaderT eff a`) to `IO`. 367 | 368 | > execReaderT :: r -> ReaderT r IO a -> IO a 369 | > execReaderT r x = runReaderT x r 370 | 371 | Running our custom WebDriver monad is then straightforward. 372 | 373 | > example4 :: Tier -> IO () 374 | > example4 t = do 375 | > execReaderT (env t) $ 376 | > execWebDriverTT defaultWebDriverConfig 377 | > (runIsolated_ defaultFirefoxCapabilities custom_environment) 378 | > return () 379 | 380 | Try it out with 381 | 382 | example4 Test 383 | example4 Production 384 | 385 | We can similarly use a custom inner monad to check assertions and with the tasty integration; there are analogous `debugWebDriverTT` and `testCaseTT` functions. 386 | 387 | `ReaderT` is just one option for the inner monad transformer. We could put mutable state, delimited continuations, or even another HTTP API monad in there. Use your imagination! 388 | 389 | 390 | 391 | Debugging 392 | --------- 393 | 394 | Running browser sessions is one thing, but writing and debugging them is another. `webdriver-w3c` has some tools for dealing with this as well. Besides the log, which gives a thorough account of what happened, we can include breakpoints in our code. When breakpoints are activated, they stop the session and give us a chance to poke around the browser before moving on. 395 | 396 | Here's a simple example. 397 | 398 | > stop_and_smell_the_ajax :: (Monad eff) => WebDriverT eff () 399 | > stop_and_smell_the_ajax = do 400 | > breakpointsOn 401 | > 402 | > navigateTo "https://google.com" 403 | > 404 | > breakpoint "Just checking" 405 | > 406 | > navigateTo "https://mozilla.org" 407 | > 408 | > breakpoint "are we there yet" 409 | 410 | We can run this with `example5`: 411 | 412 | > example5 :: IO () 413 | > example5 = do 414 | > execWebDriverT defaultWebDriverConfig 415 | > (runIsolated_ defaultFirefoxCapabilities stop_and_smell_the_ajax) 416 | > return () 417 | 418 | The basic `breakpoint` command gives the option to continue, throw an error, dump the current state and environment to stdout, and turn breakpoints off. A fancier version, `breakpointWith`, takes an additional argument letting us trigger a custom action. 419 | 420 | 421 | 422 | Where to Learn More 423 | ------------------- 424 | 425 | For now the canonical documentation is the haddock annotations on [Hackage](https://hackage.haskell.org/package/webdriver-w3c). 426 | -------------------------------------------------------------------------------- /app/ParallelStressTest.hs: -------------------------------------------------------------------------------- 1 | {- 2 | This program is meant to simulate running a large number of tests in parallel. To set the number of tests to be run, export the WD_STRESS_TEST_NUM_TESTS variable in the shell. 3 | -} 4 | 5 | {-# LANGUAGE OverloadedStrings #-} 6 | module Main where 7 | 8 | import Test.Tasty 9 | import Test.Tasty.WebDriver 10 | 11 | import Web.Api.WebDriver 12 | 13 | import System.Exit (exitFailure) 14 | import System.Environment (lookupEnv) 15 | import Text.Read (readMaybe) 16 | 17 | _test :: (Monad eff) => WebDriverT eff () 18 | _test = navigateTo "https://google.com" 19 | 20 | 21 | main :: IO () 22 | main = do 23 | var <- lookupEnv "WD_STRESS_TEST_NUM_TESTS" 24 | 25 | k <- case var >>= readMaybe of 26 | Nothing -> showError 27 | Just m -> if m <= 0 28 | then showError 29 | else return m 30 | 31 | defaultWebDriverMain $ 32 | localOption (SilentLog) $ 33 | testGroup "Test Demo" $ 34 | [ testCase ("navigate to google.com #" ++ show i) _test | i <- [1..k] ] 35 | 36 | 37 | showError :: IO a 38 | showError = do 39 | putStrLn "WD_STRESS_TEST_NUM_TESTS must be a positive integer." 40 | exitFailure 41 | -------------------------------------------------------------------------------- /app/ReplDemo.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Main where 3 | 4 | import Control.Monad.IO.Class 5 | import Data.List (isInfixOf) 6 | import Data.Text (Text) 7 | 8 | import Web.Api.WebDriver 9 | 10 | {- 11 | Utilities for demoing webdriver sessions. I mostly use this for testing 12 | and development. To run an individual demo, first make sure your remote end 13 | (chromedriver or geckodriver) is running on the correct port, then from ghci 14 | say something like: 15 | 16 | withChromedriver normalChrome demoNewWindow 17 | 18 | The executable runs all the demos, although this is less useful. 19 | -} 20 | 21 | main :: IO () 22 | main = do 23 | withChromedriver normalChrome demoNewWindow 24 | withChromedriver normalChrome demoGetComputedRole 25 | withChromedriver normalChrome demoGetComputedLabel 26 | 27 | withChromedriver headlessChrome demoPrintPage 28 | 29 | 30 | 31 | 32 | 33 | withChromedriver :: Capabilities -> WebDriverT IO () -> IO () 34 | withChromedriver caps acts = do 35 | execWebDriverT chromeConfig $ 36 | runIsolated_ caps acts 37 | return () 38 | 39 | chromeConfig :: WebDriverConfig IO 40 | chromeConfig = defaultWebDriverConfig 41 | { _environment = defaultWebDriverEnvironment 42 | { _env = defaultWDEnv 43 | { _remotePort = 9515 44 | , _responseFormat = SpecFormat 45 | } 46 | } 47 | } 48 | 49 | normalChrome :: Capabilities 50 | normalChrome = defaultChromeCapabilities 51 | 52 | headlessChrome :: Capabilities 53 | headlessChrome = defaultChromeCapabilities 54 | { _chromeOptions = Just $ defaultChromeOptions 55 | { _chromeArgs = Just ["--headless"] 56 | } 57 | } 58 | 59 | consoleLogChrome :: Capabilities 60 | consoleLogChrome = defaultChromeCapabilities 61 | { _chromeOptions = Just $ defaultChromeOptions 62 | { _chromeArgs = Just ["--user-data-dir=datadir", "--enable-logging", "--v=1"] 63 | } 64 | } 65 | 66 | 67 | 68 | demoNewWindow :: WebDriverT IO () 69 | demoNewWindow = do 70 | -- open google.com in the current tab 71 | navigateTo "https://www.google.com" 72 | 73 | -- open a new tab; but do not switch to it 74 | (handle, _) <- newWindow TabContext 75 | 76 | -- switch to the new tab 77 | switchToWindow handle 78 | 79 | -- open bing.com in this tab 80 | navigateTo "https://www.bing.com" 81 | 82 | wait 5000000 83 | return () 84 | 85 | 86 | 87 | demoGetComputedRole :: WebDriverT IO () 88 | demoGetComputedRole = do 89 | -- open google.com 90 | navigateTo "https://www.google.com" 91 | 92 | -- get the ARIA role of whatever element is active on page load 93 | role <- getActiveElement >>= getComputedRole 94 | 95 | comment $ "Computed role is '" <> role <> "'" 96 | wait 5000000 97 | return () 98 | 99 | 100 | 101 | demoGetComputedLabel :: WebDriverT IO () 102 | demoGetComputedLabel = do 103 | -- open google.com 104 | navigateTo "https://www.google.com" 105 | 106 | -- get the ARIA label of whatever element is active on page load 107 | role <- getActiveElement >>= getComputedLabel 108 | 109 | comment $ "Computed label is '" <> role <> "'" 110 | wait 5000000 111 | return () 112 | 113 | 114 | 115 | demoPrintPage :: WebDriverT IO () 116 | demoPrintPage = do 117 | -- open google.com 118 | navigateTo "https://www.google.com" 119 | 120 | -- print 121 | pdf <- printPage defaultPrintOptions 122 | writeBase64EncodedPdf "testprint.pdf" pdf 123 | 124 | wait 5000000 125 | return () 126 | 127 | 128 | 129 | -- use this to demonstrate getting the JS console log 130 | -- withChromedriver consoleLogChrome demoConsoleLogChrome 131 | demoConsoleLogChrome :: WebDriverT IO () 132 | demoConsoleLogChrome = do 133 | -- open google.com 134 | navigateTo "https://www.google.com" 135 | 136 | executeScript "console.error('HEYOOOO')" [] 137 | 138 | -- logLines <- fmap lines $ liftIO $ readFile "~/datadir/chrome_debug.log" -- you'll need to expand ~ here 139 | -- let lines = filter ("CONSOLE" `isInfixOf`) logLines 140 | -- liftIO $ print lines 141 | 142 | wait 5000000 143 | return () 144 | -------------------------------------------------------------------------------- /app/TastyDemo.lhs: -------------------------------------------------------------------------------- 1 | Using `webdriver-w3c` with `tasty` 2 | ================================== 3 | 4 | It's possible to run "raw" WebDriver sessions, but it's much more convenient to use the [tasty](https://hackage.haskell.org/package/tasty) integration. With tasty we can incorporate WebDriver tests alongside, say, quickcheck and HUnit tests, and get test reports, stats, filtering, and parallel execution for free. 5 | 6 | This module demonstrates how to set up a basic test executable and configure it with command line options. 7 | 8 | > {-# LANGUAGE OverloadedStrings #-} 9 | > module Main where 10 | 11 | We'll need some imports. These are the usual `tasty` modules: 12 | 13 | > import Test.Tasty 14 | > import Test.Tasty.ExpectedFailure 15 | 16 | These are the `webdriver-w3c` modules: 17 | 18 | > import Web.Api.WebDriver 19 | 20 | And this is the module that integrates the two. 21 | 22 | > import Test.Tasty.WebDriver 23 | 24 | 25 | Define your tests 26 | ----------------- 27 | 28 | First things first: to make a WebDriver test suite, we need some WebDriver tests. These are just values of type `WebDriverT IO ()`. (Or more generally, `(Monad eff, Monad (t eff), MonadTrans t) => WebDriverTT t eff ()`, but that's not important for now.) Here are a few dweeby examples. It's not necessary for the tests to start with `_test` or use snake_case; I'm doing it here out of habit. 29 | 30 | > _test_one :: (Monad eff) => WebDriverT eff () 31 | > _test_one = do 32 | > navigateTo "https://google.com" 33 | > 34 | > _test_two :: (Monad eff) => WebDriverT eff () 35 | > _test_two = do 36 | > navigateTo "https://yahoo.com" 37 | > assertSuccess "time travel achieved" 38 | 39 | 40 | Define your `main` 41 | ------------------ 42 | 43 | As usual, our program starts with `main`. 44 | 45 | The simplest way to make a test executable with tasty is to use `defaultWebDriverMain`, which has the following signature: 46 | 47 | defaultWebDriverMain :: TestTree -> IO () 48 | 49 | This function wraps tasty's `defaultMain`, which handles command line option parsing, and adds some magic of its own. `TestTree` is tasty's type for an executable test suite. There are several functions for building these out of WebDriver sessions; they live in `Test.Tasty.WebDriver` and have names starting with `testCase`. 50 | 51 | Here's an example `main`. 52 | 53 | > main :: IO () 54 | > main = defaultWebDriverMain $ 55 | > testGroup "Test Demo" 56 | > [ testCase "navigate to google.com" _test_one 57 | > , testCase "check status" _test_two 58 | > , ifDriverIs Chromedriver ignoreTest $ 59 | > testCase "navigate to google.com" _test_one 60 | > ] 61 | 62 | We can run different sets of tests based on the value of an option using `askOption`, and we can change the value of an option locally using `localOption`. Changing one option based on the value of another option is a common task; for example, some tests should run differently in headless mode. 63 | 64 | Several common uses of the `askOption` pattern are defined in `Test.Tasty.WebDriver`; for instance, the helper function `ifDriverIs` lets us adjust options for different drivers, and `ifTierIs` lets us change behavior between development and testing deployments. 65 | 66 | 67 | Start your remotes 68 | ------------------ 69 | 70 | To actually run our test suite, we need to have at least one _remote end_ running. These are the proxy servers that accept WebDriver requests via http and reach into a browser to make it do stuff. For now, the library has only been tested with geckodriver and chromedriver. Make sure you've got one or both of those installed, then kick off an instance of each one. 71 | 72 | For example, 73 | ``` 74 | geckodriver > /dev/null 2> /dev/null & 75 | ``` 76 | starts a geckodriver instance in the background (but suppresses its otherwise voluminous debug output). 77 | 78 | You'll want to take note of which host and port your remote end is listening on. By default, geckodriver listens on localhost, port 4444, and chromedriver listens on 9515. 79 | 80 | 81 | Run your tests 82 | -------------- 83 | 84 | This demo executable is named `wd-tasty-demo`. If you install and run it, you'll get an error message: 85 | 86 | Error: no remotes defined for geckodriver 87 | 88 | What does this mean? To run a webdriver session, we have to tell our program the URIs of the remote ends it should use -- it does not assume one. There are two ways to do this, and you can use either one (or both). 89 | 90 | `--wd-remote-ends` lets us supply the remote end URIs on the command line directly. Suppose I've got geckodriver listening on port 4444 and chromedriver on port 9515 (which they do by default). Then I'd use the following option: 91 | 92 | --wd-remote-ends 'geckodriver https://localhost:4444 chromedriver https://localhost:9515' 93 | 94 | (Note the explicit `https` scheme; this is required.) This is fine if you have a small number of remote ends running, but the command line quickly gets unwieldy if you have tens or hundreds of remote ends ready to run tests in parallel. So we can also specify the remote end URIs in a specially formatted config file. The config file must look something like this: 95 | 96 | geckodriver 97 | - https://localhost:4444 98 | - https://localhost:4445 99 | chromedriver 100 | - https://localhost:9515 101 | - https://localhost:9516 102 | 103 | The drivers can come in any order and don't have to be contiguous, and blank lines are ignored. Suppose this file is called `~/.wd/config`; then we supply this to our test executable with the following option: 104 | 105 | --wd-remote-ends-config ~/.wd/config 106 | 107 | `webdriver-w3c` can also run your tests in parallel. To take advantage of this, you'll need to compile your executable with `-threaded -rtsopts -with-rtsopts=-N` and start it with the `--num-threads N` option. You'll also need to start more than one remote end of each type. Note that if you want to run N tests in parallel, then you'll need N instances of _each_ remote end (geckodriver and chromedriver) running in the background. This is because the tests are _processed_ sequentially, even if they run in parallel. For instance, if you have 100 firefox tests followed by 100 chrome tests, but run them with one geckodriver and one chromedriver, the tests will run sequentially. 108 | 109 | There are a bunch of other command line options for tweaking the behavior of your webdriver tests; use `wd-tasty-demo --help` to see a list. Most of these are pretty specialized. Other options are pretty common. In addition to `--wd-remote-ends` and `--wd-remote-ends-config`, there's `--wd-driver`, for specifying which driver to use, and `--wd-response-format`, which was required when using old versions of chromedriver because it was not fully spec compliant. 110 | 111 | 112 | Example sessions 113 | ---------------- 114 | 115 | Here are some example commands for running this demo. 116 | 117 | Run one at a time with geckodriver: 118 | 119 | ``` 120 | geckodriver --port 4444 > /dev/null 2> /dev/null & 121 | wd-tasty-demo --wd-remote-ends 'geckodriver https://localhost:4444' 122 | ``` 123 | 124 | Run one at a time with geckodriver, but can it with all the logs: 125 | 126 | ``` 127 | geckodriver --port 4444 > /dev/null 2> /dev/null & 128 | wd-tasty-demo --wd-remote-ends 'geckodriver https://localhost:4444' --wd-verbosity silent 129 | ``` 130 | 131 | Run one at a time with chromedriver: 132 | 133 | ``` 134 | chromedriver --port=9515 & 135 | wd-tasty-demo --wd-driver chromedriver --wd-remote-ends 'chromedriver https://localhost:9515' 136 | ``` 137 | 138 | Run two at a time with geckodriver: 139 | 140 | ``` 141 | geckodriver --port 4444 > /dev/null 2> /dev/null & 142 | wd-tasty-demo --wd-remote-ends 'geckodriver https://localhost:4444' --num-threads 2 143 | ``` 144 | -------------------------------------------------------------------------------- /code-of-conduct.md: -------------------------------------------------------------------------------- 1 | # Contributor Covenant Code of Conduct 2 | 3 | ## Our Pledge 4 | 5 | In the interest of fostering an open and welcoming environment, we as 6 | contributors and maintainers pledge to making participation in our project and 7 | our community a harassment-free experience for everyone, regardless of age, body 8 | size, disability, ethnicity, gender identity and expression, level of experience, 9 | education, socio-economic status, nationality, personal appearance, race, 10 | religion, or sexual identity and orientation. 11 | 12 | ## Our Standards 13 | 14 | Examples of behavior that contributes to creating a positive environment 15 | include: 16 | 17 | * Using welcoming and inclusive language 18 | * Being respectful of differing viewpoints and experiences 19 | * Gracefully accepting constructive criticism 20 | * Focusing on what is best for the community 21 | * Showing empathy towards other community members 22 | 23 | Examples of unacceptable behavior by participants include: 24 | 25 | * The use of sexualized language or imagery and unwelcome sexual attention or 26 | advances 27 | * Trolling, insulting/derogatory comments, and personal or political attacks 28 | * Public or private harassment 29 | * Publishing others' private information, such as a physical or electronic 30 | address, without explicit permission 31 | * Other conduct which could reasonably be considered inappropriate in a 32 | professional setting 33 | 34 | ## Our Responsibilities 35 | 36 | Project maintainers are responsible for clarifying the standards of acceptable 37 | behavior and are expected to take appropriate and fair corrective action in 38 | response to any instances of unacceptable behavior. 39 | 40 | Project maintainers have the right and responsibility to remove, edit, or 41 | reject comments, commits, code, wiki edits, issues, and other contributions 42 | that are not aligned to this Code of Conduct, or to ban temporarily or 43 | permanently any contributor for other behaviors that they deem inappropriate, 44 | threatening, offensive, or harmful. 45 | 46 | ## Scope 47 | 48 | This Code of Conduct applies both within project spaces and in public spaces 49 | when an individual is representing the project or its community. Examples of 50 | representing a project or community include using an official project e-mail 51 | address, posting via an official social media account, or acting as an appointed 52 | representative at an online or offline event. Representation of a project may be 53 | further defined and clarified by project maintainers. 54 | 55 | ## Enforcement 56 | 57 | Instances of abusive, harassing, or otherwise unacceptable behavior may be 58 | reported by contacting the project team at nbloomf@gmail.com. All 59 | complaints will be reviewed and investigated and will result in a response that 60 | is deemed necessary and appropriate to the circumstances. The project team is 61 | obligated to maintain confidentiality with regard to the reporter of an incident. 62 | Further details of specific enforcement policies may be posted separately. 63 | 64 | Project maintainers who do not follow or enforce the Code of Conduct in good 65 | faith may face temporary or permanent repercussions as determined by other 66 | members of the project's leadership. 67 | 68 | ## Attribution 69 | 70 | This Code of Conduct is adapted from the [Contributor Covenant][homepage], version 1.4, 71 | available at https://www.contributor-covenant.org/version/1/4/code-of-conduct.html 72 | 73 | [homepage]: https://www.contributor-covenant.org 74 | 75 | -------------------------------------------------------------------------------- /dev/doc.md: -------------------------------------------------------------------------------- 1 | Info for Developers 2 | =================== 3 | 4 | Here's some notes about the implementation of webdriver-w3c. 5 | 6 | 7 | Setting up an Environment 8 | ------------------------- 9 | 10 | To have a complete dev environment and run all the tests, you'll need to install [geckodriver](https://github.com/mozilla/geckodriver/releases) and [chromedriver](http://chromedriver.chromium.org/). 11 | 12 | For building `webdriver-w3c` itself or your own projects, I recommend [stack](https://docs.haskellstack.org/en/stable/README/) for ease of use. With stack and this repo on your machine, 13 | 14 | * `stack ghci` loads the library in a ghci session 15 | * `make test` runs the tests and generates a code coverage report 16 | 17 | 18 | Structure of the Library 19 | ------------------------ 20 | 21 | The heart of the library is the `WebDriverT` monad transformer, which handles network requests, logging, errors, and other state. The bulk of the API consists of functions into this monad -- one for each endpoint in the WebDriver spec. 22 | 23 | `WebDriverT` is a specialization of `HttpT` from the `script-monad` library. Under the hood, it is a hand-rolled stack of error, reader, writer, state, and prompt monads. 24 | 25 | 26 | About Parallelism 27 | ----------------- 28 | 29 | If you have a large suite of tests, `webdriver-w3c` can speed up execution by running the tests in parallel. In fact, thanks to `tasty`, running the tests in parallel is no more complicated than running them sequentially. To take advantage of this you'll need to do two things: 30 | 31 | First: set the `--num-threads` option or the `TASTY_NUM_THREADS` environment variable higher than 1; this is the number of tests to be run simultaneously. (This also requires compiling your binary with `-threaded -rtsopts -with-rtsopts=-N`; see the [tasty documentation](https://github.com/feuerbach/tasty#running-tests-in-parallel) for details). 32 | 33 | Second: have more than one remote end running, and supply their URIs to your test executable. (When running on a CI server, `xvfb-run` is handy here.) You can specify these URIs on the command line directly with syntax like this: 34 | 35 | --remote-ends 'geckodriver: URI URI chromedriver: URI URI' 36 | 37 | If your list of remote end URIs is large or dynamically generated, you can also supply it in a config file using the following option: 38 | 39 | --remote-ends-config PATH 40 | 41 | where `PATH` is a file formatted like so: 42 | 43 | geckodriver 44 | - URI 45 | - URI 46 | chromedriver 47 | - URI 48 | - URI 49 | 50 | You can specify the remote end URIs with either `--remote-ends` or `--remote-ends-config` or both. The "blocks" of URIs per driver can be in any order and do not have to be contiguous. Note that the URIs *must* include a scheme (the `https://` part). 51 | 52 | The remote end URIs are stored in a set of mutable stacks; one for each driver. On each test run, we atomically pop a remote end URI from the stack, use it to run the tests, and then push the remote URI back onto the stack. If no remote ends are available, the test run waits until one becomes available. 53 | 54 | Note that while the tests can be _executed_ in parallel, they are still _processed_ sequentially. In particular, if you've got 100 firefox tests followed by 100 chrome tests, and provide exactly one firefox remote end and one chrome remote end, your tests will not run in parallel. The chrome remote will sit idle until all the firefox tests have finished. To get the full benefit of parallelism, I recommend having N firefox remotes and N chrome remotes and running the tests with N threads; this will not ensure that all 2N remotes are always busy, but will ensure that all N threads are being used. 55 | 56 | 57 | About the Tests 58 | --------------- 59 | 60 | Tests for this library fall into two buckets: API tests, where the correct behavior is dictated by the [WebDriver spec](https://www.w3.org/TR/webdriver/); and non-API tests, which cover other behaviors of the library outside the scope of the spec. The API tests are the more important of the two. 61 | 62 | The API test suite consists of a list of WebDriver scripts in the [test/Web/Api/WebDriver/Monad/Test/Session](https://github.com/nbloomf/webdriver-w3c/tree/master/test/Web/Api/WebDriver/Monad/Test/Session) directory. These tests are divided into files by expected result; e.g. [Success](https://github.com/nbloomf/webdriver-w3c/blob/master/test/Web/Api/WebDriver/Monad/Test/Session/Success.hs) consists of the scripts that should succeed, [UnknownError](https://github.com/nbloomf/webdriver-w3c/blob/master/test/Web/Api/WebDriver/Monad/Test/Session/UnknownError.hs) consists of the scripts that should fail with "unknown error", and so on. 63 | 64 | API test scripts are run against [geckodriver](https://github.com/mozilla/geckodriver) and [chromedriver](http://chromedriver.chromium.org/), as well as a mocked remote end implementation. The code for the mocked remote end is mainly in and under the [test/Web/Api/WebDriver/Monad/Test/Server](https://github.com/nbloomf/webdriver-w3c/blob/master/test/Web/Api/WebDriver/Monad/Test/Server.hs) namespace. 65 | -------------------------------------------------------------------------------- /dev/run-demo.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | stack build 4 | stack install 5 | 6 | geckodriver --marionette-port 4454 --port 4444 --log error >/dev/null 2>/dev/null & 7 | geckodriver --marionette-port 4455 --port 4445 --log error >/dev/null 2>/dev/null & 8 | chromedriver --port=9515 & 9 | chromedriver --port=9516 & 10 | 11 | wd-tasty-demo --wd-remote-ends 'geckodriver https://localhost:4444' 12 | wd-tasty-demo --wd-remote-ends 'geckodriver https://localhost:4444' --wd-verbosity silent 13 | wd-tasty-demo --wd-driver chromedriver --wd-remote-ends 'chromedriver https://localhost:9515' 14 | wd-tasty-demo --wd-remote-ends 'geckodriver https://localhost:4444' --num-threads 2 15 | 16 | killall geckodriver 17 | killall chromedriver 18 | -------------------------------------------------------------------------------- /dev/run-parallel-stress-test.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | -------------------------------------------------------------------------------- /dev/run-tests.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | stack build 4 | 5 | geckodriver --marionette-port 3828 --port 4444 --log error >/dev/null 2>/dev/null & 6 | geckodriver --marionette-port 3829 --port 4445 --log error >/dev/null 2>/dev/null & 7 | chromedriver --port=9515 & 8 | chromedriver --port=9516 & 9 | 10 | stack test --coverage 11 | stack hpc report . 12 | 13 | killall geckodriver 14 | killall chromedriver 15 | -------------------------------------------------------------------------------- /dev/test-compat.sh: -------------------------------------------------------------------------------- 1 | #! /bin/bash 2 | 3 | # This script builds and tests webdriver-w3c against stack lts 4 | # resolvers from 13.0 on, that is, resolvers with GHC >=8.6.1. That 5 | # is a hard lower bound because we rely on QuantifiedConstraints. 6 | # Watch out, this takes a long time and should probably only be run 7 | # when preparing a new release. :) 8 | 9 | # TODO: 10 | # - when a lts run finishes, write a timestamp and success message to a log 11 | 12 | export TASTY_HIDE_SUCCESSES=true 13 | 14 | from_maj=${1-9999} 15 | from_min=${2-9999} 16 | 17 | # run tests with a specific lts version 18 | test_with_lts_major_minor () { 19 | echo 20 | echo Testing with lts-$1 21 | echo "Command: stack --resolver lts-$1 test" 22 | stack --resolver lts-$1 test 23 | result=$? 24 | if [ "$result" != "0" ] 25 | then 26 | echo "Test failure!" 27 | echo "Replicate with this command:" 28 | echo "stack --resolver lts-$1" test 29 | killall geckodriver 30 | killall chromedriver 31 | exit 1 32 | fi 33 | } 34 | 35 | # run tests against all lts resolvers with fixed major version 36 | # skips major versions greater than $1, and if major version 37 | # equals $1, skips minor versions greater than $2. 38 | test_with_lts_major () { 39 | if [ $from_maj -ge $1 ] 40 | then 41 | for (( minor = $2; minor >= 0; minor-- )) 42 | do 43 | if [[ ($from_min -ge $minor) || ($from_maj -gt $1) ]] 44 | then 45 | test_with_lts_major_minor $1.$minor 46 | fi 47 | done 48 | fi 49 | } 50 | 51 | geckodriver --marionette-port 3828 --port 4444 --log error >/dev/null 2>/dev/null & 52 | geckodriver --marionette-port 3829 --port 4445 --log error >/dev/null 2>/dev/null & 53 | chromedriver --port=9515 & 54 | chromedriver --port=9516 & 55 | 56 | test_with_lts_major 19 13 57 | test_with_lts_major 18 28 58 | test_with_lts_major 17 15 59 | test_with_lts_major 16 31 60 | test_with_lts_major 15 16 61 | test_with_lts_major 14 26 62 | test_with_lts_major 13 30 63 | 64 | killall geckodriver 65 | killall chromedriver 66 | 67 | echo "All version tests passed." 68 | -------------------------------------------------------------------------------- /doc/TastyDemo.md: -------------------------------------------------------------------------------- 1 | Using `webdriver-w3c` with `tasty` 2 | ================================== 3 | 4 | It's possible to run "raw" WebDriver sessions, but it's much more 5 | convenient to use the [tasty](https://hackage.haskell.org/package/tasty) 6 | integration. With tasty we can incorporate WebDriver tests alongside, 7 | say, quickcheck and HUnit tests, and get test reports, stats, filtering, 8 | and parallel execution for free. 9 | 10 | This module demonstrates how to set up a basic test executable and 11 | configure it with command line options. 12 | 13 | ``` {.sourceCode .literate .haskell} 14 | {-# LANGUAGE OverloadedStrings #-} 15 | module Main where 16 | ``` 17 | 18 | We'll need some imports. These are the usual `tasty` modules: 19 | 20 | ``` {.sourceCode .literate .haskell} 21 | import Test.Tasty 22 | import Test.Tasty.ExpectedFailure 23 | ``` 24 | 25 | These are the `webdriver-w3c` modules: 26 | 27 | ``` {.sourceCode .literate .haskell} 28 | import Web.Api.WebDriver 29 | ``` 30 | 31 | And this is the module that integrates the two. 32 | 33 | ``` {.sourceCode .literate .haskell} 34 | import Test.Tasty.WebDriver 35 | ``` 36 | 37 | Define your tests 38 | ----------------- 39 | 40 | First things first: to make a WebDriver test suite, we need some 41 | WebDriver tests. These are just values of type `WebDriver IO ()`. (Or 42 | more generally, `Monad eff => WebDriver eff ()`, but that's not 43 | important for now.) Here are a few dweeby examples. It's not necessary 44 | for the tests to start with `_test` or use snake\_case; I'm doing it 45 | here out of habit. 46 | 47 | ``` {.sourceCode .literate .haskell} 48 | _test_one :: (Monad eff) => WebDriver eff () 49 | _test_one = do 50 | navigateTo "https://google.com" 51 | 52 | _test_two :: (Monad eff) => WebDriver eff () 53 | _test_two = do 54 | navigateTo "https://yahoo.com" 55 | assertSuccess "time travel achieved" 56 | ``` 57 | 58 | Define your `main` 59 | ------------------ 60 | 61 | As usual, our program starts with `main`. 62 | 63 | The simplest way to make a test executable with tasty is to use 64 | `defaultWebDriverMain`, which has the following signature: 65 | 66 | defaultWebDriverMain :: TestTree -> IO () 67 | 68 | This function wraps tasty's `defaultMain`, which handles command line 69 | option parsing, and adds some magic of its own. `TestTree` is tasty's 70 | type for an executable test suite. There are several functions for 71 | building these out of WebDriver sessions; they live in 72 | `Test.Tasty.WebDriver` and have names starting with `testCase`. 73 | 74 | Here's an example `main`. 75 | 76 | ``` {.sourceCode .literate .haskell} 77 | main :: IO () 78 | main = defaultWebDriverMain $ 79 | testGroup "Test Demo" 80 | [ testCase "navigate to google.com" _test_one 81 | , testCase "check status" _test_two 82 | , ifDriverIs Chromedriver ignoreTest $ 83 | testCase "navigate to google.com" _test_one 84 | ] 85 | ``` 86 | 87 | We can run different sets of tests based on the value of an option using 88 | `askOption`, and we can change the value of an option locally using 89 | `localOption`. Changing one option based on the value of another option 90 | is a common task; for example, some tests should run differently in 91 | headless mode. 92 | 93 | Several common uses of the `askOption` pattern are defined in 94 | `Test.Tasty.WebDriver`; for instance, the helper function `ifDriverIs` 95 | lets us adjust options for different drivers, and `ifTierIs` lets us 96 | change behavior between development and testing deployments. 97 | 98 | Start your remotes 99 | ------------------ 100 | 101 | To actually run our test suite, we need to have at least one *remote 102 | end* running. These are the proxy servers that accept WebDriver requests 103 | via http and reach into a browser to make it do stuff. For now, the 104 | library has only been tested with geckodriver and chromedriver. Make 105 | sure you've got one or both of those installed, then kick off an 106 | instance of each one. 107 | 108 | For example, 109 | 110 | geckodriver > /dev/null 2> /dev/null & 111 | 112 | starts a geckodriver instance in the background (but suppresses its 113 | otherwise voluminous debug output). 114 | 115 | You'll want to take note of which host and port your remote end is 116 | listening on. By default, geckodriver listens on localhost, port 4444, 117 | and chromedriver listens on 9515. 118 | 119 | Run your tests 120 | -------------- 121 | 122 | This demo executable is named `wd-tasty-demo`. If you install and run 123 | it, you'll get an error message: 124 | 125 | Error: no remotes defined for geckodriver 126 | 127 | What does this mean? To run a webdriver session, we have to tell our 128 | program the URIs of the remote ends it should use -- it does not assume 129 | one. There are two ways to do this, and you can use either one (or 130 | both). 131 | 132 | `--wd-remote-ends` lets us supply the remote end URIs on the command 133 | line directly. Suppose I've got geckodriver listening on port 4444 and 134 | chromedriver on port 9515 (which they do by default). Then I'd use the 135 | following option: 136 | 137 | --wd-remote-ends 'geckodriver: https://localhost:4444 chromedriver: https://localhost:9515' 138 | 139 | (Note the explicit `https` scheme; this is required.) This is fine if 140 | you have a small number of remote ends running, but the command line 141 | quickly gets unwieldy if you have tens or hundreds of remote ends ready 142 | to run tests in parallel. So we can also specify the remote end URIs in 143 | a specially formatted config file. The config file must look something 144 | like this: 145 | 146 | geckodriver 147 | - https://localhost:4444 148 | - https://localhost:4445 149 | chromedriver 150 | - https://localhost:9515 151 | - https://localhost:9516 152 | 153 | The drivers can come in any order and don't have to be contiguous, and 154 | blank lines are ignored. Suppose this file is called `~/.wd/config`; 155 | then we supply this to our test executable with the following option: 156 | 157 | --wd-remote-ends-config ~/.wd/config 158 | 159 | `webdriver-w3c` can also run your tests in parallel. To take advantage 160 | of this, you'll need to compile your executable with 161 | `-threaded -rtsopts -with-rtsopts=-N` and start it with the 162 | `--num-threads N` option. You'll also need to start more than one remote 163 | end of each type. Note that if you want to run N tests in parallel, then 164 | you'll need N instances of *each* remote end (geckodriver and 165 | chromedriver) running in the background. This is because the tests are 166 | *processed* sequentially, even if they run in parallel. For instance, if 167 | you have 100 firefox tests followed by 100 chrome tests, but run them 168 | with one geckodriver and one chromedriver, the tests will run 169 | sequentially. 170 | 171 | There are a bunch of other command line options for tweaking the 172 | behavior of your webdriver tests; use `wd-tasty-demo --help` to see a 173 | list. Most of these are pretty specialized. Other options are pretty 174 | common. In addition to `--wd-remote-ends` and `--wd-remote-ends-config`, 175 | there's `--wd-driver`, for specifying which driver to use, and 176 | `--wd-response-format`, which is required when using chromedriver 177 | because chromedriver is not fully spec compliant. 178 | 179 | Example sessions 180 | ---------------- 181 | 182 | Here are some example commands for running this demo. 183 | 184 | Run one at a time with geckodriver: 185 | 186 | geckodriver --port 4444 > /dev/null 2> /dev/null & 187 | wd-tasty-demo --wd-remote-ends 'geckodriver: https://localhost:4444' 188 | 189 | Run one at a time with geckodriver, but can it with all the logs: 190 | 191 | geckodriver --port 4444 > /dev/null 2> /dev/null & 192 | wd-tasty-demo --wd-remote-ends 'geckodriver: https://localhost:4444' --wd-verbosity silent 193 | 194 | Run one at a time with chromedriver: 195 | 196 | chromedriver --port=9515 & 197 | wd-tasty-demo --wd-driver chromedriver --wd-response-format chromedriver --wd-remote-ends 'chromedriver: https://localhost:9515' 198 | 199 | Run two at a time with geckodriver: 200 | 201 | geckodriver --port 4444 > /dev/null 2> /dev/null & 202 | wd-tasty-demo --wd-remote-ends 'geckodriver: https://localhost:4444' --num-threads 2 203 | -------------------------------------------------------------------------------- /doc/Tutorial.md: -------------------------------------------------------------------------------- 1 | Getting Started with `webdriver-w3c` 2 | ------------------------------------ 3 | 4 | Hello, and welcome to the wonderful world of browser automation with 5 | WebDriver and Haskell! This module is a brief tutorial on how we can use 6 | use the `webdriver-w3c` library to write Haskell programs that interact 7 | with web pages just like a person would. If you need to test a web 8 | application, or want to automate some web thing that curl and wget alone 9 | can't handle easily, you might find this mildly interesting, maybe. 10 | 11 | (This text is a literate program, so we have to start with some compiler 12 | noises. Nothing to see here!) 13 | 14 | ``` {.sourceCode .literate .haskell} 15 | {-# LANGUAGE OverloadedStrings #-} 16 | module Main where 17 | 18 | import Web.Api.WebDriver 19 | import Test.Tasty.WebDriver 20 | 21 | import Test.Tasty 22 | import qualified System.Environment as SE 23 | import Control.Monad 24 | 25 | main :: IO () 26 | main = return () 27 | ``` 28 | 29 | Prerequisites 30 | ------------- 31 | 32 | To follow along, you're going to need a few things. 33 | 34 | 1. [Stack](https://docs.haskellstack.org/en/stable/README/). Stack is a 35 | build tool for Haskell projects. It compiles our programs, runs 36 | tests, processes documentation, generates code coverage reports, and 37 | keeps project dependencies under control. 38 | 2. A copy of this repository 39 | 3. A web browser; this tutorial assumes you're using Firefox. 40 | 4. A WebDriver proxy server for your browser. For Firefox this is 41 | [geckodriver](https://github.com/mozilla/geckodriver). Don't sweat 42 | it if you don't know what "WebDriver proxy server" means right now, 43 | we'll get to that. 44 | 45 | Next, start your proxy server. For geckodriver on unix-like OSs, that is 46 | done with the `geckodriver &` command. You should see a line that looks 47 | something like this: 48 | 49 | 1521524046173 geckodriver INFO Listening on 127.0.0.1:4444 50 | 51 | Leave that program running. Just leave it alone. 52 | 53 | Finally, in another shell window, navigate to the directory holding this 54 | repo and say 55 | 56 | stack ghci webdriver-w3c:webdriver-w3c-intro 57 | 58 | Well, don't *say* that, out loud. Type it. :) This might take a while 59 | the first time while stack downloads the compiler and libraries it 60 | needs. When it finishes, this command opens a Haskell interpreter with 61 | `webdriver-w3c` loaded so we can play with it. You'll know everything is 62 | okay if you see a line like 63 | 64 | Ok, one module loaded. 65 | 66 | followed by a `λ:` prompt. To be sure, try typing in `return` and then 67 | hit (enter). If you see this scary error message: 68 | 69 | :1:1: error: 70 | • No instance for (Show (a0 -> m0 a0)) 71 | arising from a use of ‘print’ 72 | (maybe you haven't applied a function to enough arguments?) 73 | • In a stmt of an interactive GHCi command: print it 74 | 75 | then everything is working great! 76 | 77 | My First Browser Automation 78 | --------------------------- 79 | 80 | Ok! You've got your WebDriver proxy (geckodriver) running in one 81 | terminal window, and ghci running in another. Let's start with a simple 82 | example to illustrate what we can do, then explain how it works. Read 83 | this code block, even if the syntax is meaningless. 84 | 85 | ``` {.sourceCode .literate .haskell} 86 | do_a_barrel_roll :: WebDriver IO () 87 | do_a_barrel_roll = do 88 | fullscreenWindow 89 | navigateTo "https://www.google.com" 90 | performActions [typeString "do a barrel roll"] 91 | performActions [press EnterKey] 92 | wait 5000000 93 | return () 94 | ``` 95 | 96 | Without running that code -- and maybe without being proficient in 97 | Haskell -- what do you think it does? 98 | 99 | Now let's run it. In the interpreter, type 100 | 101 | example1 102 | 103 | followed by (enter). You should see a Firefox window open, go 104 | fullscreen, and search Google for "do a barrel roll". 105 | 106 | `example1`, by the way, is this: 107 | 108 | ``` {.sourceCode .literate .haskell} 109 | example1 :: IO () 110 | example1 = do 111 | execWebDriver defaultWebDriverConfig 112 | (runIsolated_ defaultFirefoxCapabilities do_a_barrel_roll) 113 | return () 114 | ``` 115 | 116 | Let's break down what just happened. 117 | 118 | 1. `do_a_barrel_roll` is a *WebDriver session*, expressed in the 119 | `WebDriver` DSL. It's a high-level description for a sequence of 120 | browser actions: in this case, "make the window full screen", 121 | "navigate to google.com", and so on. 122 | 2. `runIsolated_` takes a WebDriver session and runs it in a fresh 123 | browser instance. The parameters of this instance are specified in 124 | `defaultFirefoxCapabilities`. 125 | 3. `execWebDriver` takes a WebDriver session and carries out the steps, 126 | using some options specified in `defaultWebDriverConfig`. 127 | 128 | You probably also noticed a bunch of noise got printed to your terminal 129 | starting with something like this: 130 | 131 | λ: example1 132 | 2018-06-23 15:19:46 Request POST http://localhost:4444/session 133 | { 134 | "capabilities": { 135 | "alwaysMatch": { 136 | "browserName": "firefox" 137 | } 138 | }, 139 | "desiredCapabilities": { 140 | "browserName": "firefox" 141 | } 142 | } 143 | 2018-06-23 15:19:48 Response 144 | { 145 | "value": { 146 | "sessionId": "383edca7-3054-0544-8c1e-cc64099462de", 147 | "capabilities": { 148 | "moz:webdriverClick": true, 149 | "platformVersion": "17.4.0", 150 | "moz:headless": false, 151 | "moz:useNonSpecCompliantPointerOrigin": false, 152 | "browserVersion": "60.0.2", 153 | "rotatable": false, 154 | "pageLoadStrategy": "normal", 155 | "moz:profile": "/var/folders/td/sxyy9wl919740vddr49g8nth0000gn/T/rust_mozprofile.aleh5JscOwwI", 156 | "moz:accessibilityChecks": false, 157 | "moz:processID": 88470, 158 | "platformName": "darwin", 159 | "timeouts": { 160 | "implicit": 0, 161 | "script": 30000, 162 | "pageLoad": 300000 163 | }, 164 | "acceptInsecureCerts": false, 165 | "browserName": "firefox" 166 | } 167 | } 168 | } 169 | 170 | This is the log. WebDriver sessions keep track of a bunch of info to 171 | help with debugging, like all requests and responses and all raised 172 | errors. By default the logs are printed to stderr but this is 173 | configurable. 174 | 175 | So what can you do in a WebDriver session? Not much -- but this is by 176 | design. The library includes: 177 | 178 | - A binding for each endpoint in the WebDriver spec 179 | - Some basic functions for reading and writing files, reading and 180 | writing at the console, and making arbitrary HTTP requests 181 | 182 | This plus Haskell's `do` notation make for a tidy EDSL for running 183 | browsers. Notably, a `WebDriver` session cannot do arbitrary `IO` by 184 | default, and `WebDriver` sessions are pure values. (There is an escape 185 | hatch for this restriction.) 186 | 187 | Behind the Scenes 188 | ----------------- 189 | 190 | WebDriver is an HTTP API for controlling web browsers like a human user 191 | would. In principle a browser could implement this API directly. In 192 | practice the major browsers have their own internally maintained APIs 193 | for automation and use a *proxy server* to translate between WebDriver 194 | and their internal API. 195 | 196 | This is the role geckodriver is playing in our examples so far: deep 197 | down, our code is making HTTP requests to geckodriver, and geckodriver 198 | is passing these requests on to Firefox. 199 | 200 | This library is also tested against Chrome via chromedriver. To do that, 201 | using `chromedriver`'s default settings, we need to make a couple of 202 | adjustments to the examples: replace 203 | 204 | defaultWebDriverConfig 205 | 206 | by 207 | 208 | defaultWebDriverConfig 209 | { _env = defaultWDEnv 210 | { _remotePort = 9515 211 | , _responseFormat = ChromeFormat 212 | } 213 | } 214 | 215 | and replace 216 | 217 | defaultFirefoxCapabilities 218 | 219 | by 220 | 221 | defaultChromeCapabilities 222 | 223 | (By the way - `defaultWebDriverConfig` has type `WebDriverConfig`, and 224 | includes knobs for tweaking almost everything about how our sessions 225 | run.) 226 | 227 | Making Assertions 228 | ----------------- 229 | 230 | It's expected that you're probably interested in using browser 231 | automation to run end-to-end tests on some web application -- and 232 | `webdriver-w3c` has some extra bits built in to make this simpler. 233 | 234 | In addition to the usual browser action commands, you can sprinkle your 235 | `WebDriver` sessions with *assertions*. Here's an example. 236 | 237 | ``` {.sourceCode .literate .haskell} 238 | what_page_is_this :: (Monad eff) => WebDriver eff () 239 | what_page_is_this = do 240 | navigateTo "https://www.google.com" 241 | title <- getTitle 242 | assertEqual title "Welcome to Lycos!" "Making sure we're at the lycos homepage" 243 | return () 244 | ``` 245 | 246 | Note the signature: `(Monad eff) => WebDriver eff ()` instead of 247 | `WebDriver IO ()`. What's happening here is that `WebDriver` is 248 | parameterized by the monad that effects (like writing to files and 249 | making HTTP requests) take place in. These effects are "run" by an 250 | explicit evaluator that, for the default configuration, happens to use 251 | `IO`, but both the effect monad and the evaluator are configurable. By 252 | swapping out `IO` for another type we can, for example, run our tests 253 | against a mock Internet, and swapping out the evaluator we might have a 254 | "dry run" evaluator that doesn't actually do anything, but logs what it 255 | would have done. It's good practice to make our `WebDriver` code 256 | maximally flexible by using an effect parameter like `eff` instead of 257 | the concrete `IO` unless there's a good reason not to. 258 | 259 | Anyway, back to the example. What do you think this code does? Let's try 260 | it: type 261 | 262 | example2 263 | 264 | in the interpreter. You should see a browser window open briefly to 265 | google.com, with a scary "Invalid Assertion" message in the interpreter. 266 | `assertEqual` is the assertion statement: it takes two things (strings 267 | in this case) and checks whether they are equal. Shocking, hm? The third 268 | argument to `assertEqual` is a *comment*, so we can include some human 269 | readable info as to *why* this assertion was made. 270 | 271 | This is `example2`: 272 | 273 | ``` {.sourceCode .literate .haskell} 274 | example2 :: IO () 275 | example2 = do 276 | (_, result) <- debugWebDriver defaultWebDriverConfig 277 | (runIsolated_ defaultFirefoxCapabilities what_page_is_this) 278 | printSummary result 279 | return () 280 | ``` 281 | 282 | Here's what happened: 283 | 284 | 1. `what_page_is_this` is a WebDriver session, just like 285 | `do_a_barrel_roll`, this time including an assertion: that the title 286 | of some web page is "Welcome to Lycos!". 287 | 2. `runIsolated_` runs `what_page_is_this` in a fresh browser instance. 288 | 3. `debugWebDriver` works much like `execWebDriver`, except that it 289 | collects the results of any assertion statements and summarizes them 290 | (this is `result`). 291 | 4. `printSummary` takes the assertion results and prints them out all 292 | pretty like. 293 | 294 | Documentation on assertions is on 295 | [Hackage](https://hackage.haskell.org/package/webdriver-w3c-0.0.1/docs/Web-Api-WebDriver-Assert.html). 296 | 297 | Suites of Tests 298 | --------------- 299 | 300 | Alright. If you're writing e2e tests, you probably want to write a *lot* 301 | of e2e tests. In this case, we'd like our tests to be modular, isolated, 302 | and well-organized, so that when things go wrong we can quickly diagnose 303 | what happened. For this, `webdriver-w3c` integrates with the 304 | [tasty](https://hackage.haskell.org/package/tasty) test framework -- 305 | just import `Test.Tasty.WebDriver`. 306 | 307 | Suppose we've got two WebDriver tests. These are pretty dweeby just for 308 | illustration's sake. 309 | 310 | ``` {.sourceCode .literate .haskell} 311 | back_button :: (Monad eff) => WebDriver eff () 312 | back_button = do 313 | navigateTo "https://www.google.com" 314 | navigateTo "https://wordpress.com" 315 | goBack 316 | title <- getTitle 317 | assertEqual title "Google" "Behavior of 'back' button from WordPress homepage" 318 | return () 319 | 320 | refresh_page :: (Monad eff) => WebDriver eff () 321 | refresh_page = do 322 | navigateTo "https://www.mozilla.org" 323 | pageRefresh 324 | title <- getTitle 325 | assertEqual title "Mozilla's Epic HomePage on the Internets" 326 | "Refresh mozilla.org" 327 | return () 328 | ``` 329 | 330 | We can organize them into a hierarchy of tests like so. 331 | 332 | ``` {.sourceCode .literate .haskell} 333 | test_suite :: TestTree 334 | test_suite = testGroup "All Tests" 335 | [ testCase "Back Button" back_button 336 | , testCase "Refresh" refresh_page 337 | ] 338 | ``` 339 | 340 | Try running the suite with 341 | 342 | example3 343 | 344 | in the interpreter. Here's what `example3` looks like: 345 | 346 | ``` {.sourceCode .literate .haskell} 347 | example3 :: IO () 348 | example3 = do 349 | SE.setEnv "TASTY_NUM_THREADS" "1" 350 | defaultWebDriverMain 351 | $ localOption (SilentLog) 352 | $ localOption (PrivateMode True) 353 | $ test_suite 354 | ``` 355 | 356 | Here's what happened: 357 | 358 | 1. `test_suite` is a Tasty tree of individual `WebDriver` test cases. 359 | 2. `defaultWebDriverMain` is a Tasty function that runs test trees. In 360 | this case we've also used `localOption` to tweak how the tests run 361 | -- suppressing the usual session log output. 362 | 363 | Tasty gave us lots of nice things for free, like pretty printing test 364 | results and timings. 365 | 366 | λ: example3 367 | >>> Deployment environment is DEV 368 | >>> Logging with colors 369 | All Tests 370 | Back Button: OK (7.23s) 371 | 1 assertion(s) 372 | Refresh: FAIL (4.29s) 373 | Invalid Assertion 374 | assertion: "Internet for people, not profit \8212 Mozilla" is equal to "Mozilla's Epic HomePage on the Internets" 375 | comment: Refresh mozilla.org 376 | 377 | 1 out of 2 tests failed (11.53s) 378 | 379 | Other test case constructors and test options are available; see 380 | [Hackage](https://hackage.haskell.org/package/webdriver-w3c-0.0.1/docs/Test-Tasty-WebDriver.html) 381 | for the details. 382 | 383 | The test suite for `webdriver-w3c` itself uses the Tasty integration. 384 | There is also a function, `checkWebDriver`, that can be used to build 385 | tests with QuickCheck, if you don't find that idea abominable. :) 386 | 387 | We need more power! 388 | ------------------- 389 | 390 | The vanilla `WebDriver` is designed to help you control a browser with 391 | *batteries included*, but it has limitations. It can't possibly 392 | anticipate all the different ways you might want to control your tests, 393 | and it can't do arbitrary `IO`. But we have a powerful and very general 394 | escape hatch: `WebDriver` is a special case of the `WebDriverT` monad 395 | transformer. 396 | 397 | The actual definition of `WebDriver` is 398 | 399 | type WebDriver eff a = WebDriverT (IdentityT eff) a 400 | 401 | where `IdentityT` is the *inner monad* in transformer terms -- actually 402 | it's an inner monad transformer, on the effect monad `eff`. By swapping 403 | out `IdentityT` for another transformer we can add features specific to 404 | our application. 405 | 406 | Here's a typical example. Say you're testing a site with two deployment 407 | tiers -- "test" and "production". For the most part the same test suite 408 | should run against both tiers, but there are minor differences. Say the 409 | base URLs are slightly different; maybe production lives at 410 | `example.com` while test lives at `test.example.com`. Also while 411 | developing a new feature some parts of the test suite should only run on 412 | the test tier, maybe controlled by a feature flag. 413 | 414 | What we need is some extra read-only state to pass around. We can do 415 | this with a `ReaderT` transformer. To avoid adding a dependency on a 416 | whole transformer library, lets roll our own: 417 | 418 | ``` {.sourceCode .literate .haskell} 419 | data ReaderT r eff a = ReaderT 420 | { runReaderT :: r -> eff a 421 | } 422 | 423 | instance (Monad eff) => Monad (ReaderT r eff) where 424 | return x = ReaderT $ \_ -> return x 425 | 426 | x >>= f = ReaderT $ \r -> do 427 | a <- runReaderT x r 428 | runReaderT (f a) r 429 | 430 | instance (Monad eff) => Applicative (ReaderT r eff) where 431 | pure = return 432 | (<*>) = ap 433 | 434 | instance (Monad eff) => Functor (ReaderT r eff) where 435 | fmap f x = x >>= (return . f) 436 | 437 | liftReaderT :: (Monad eff) => eff a -> ReaderT r eff a 438 | liftReaderT x = ReaderT $ \_ -> x 439 | 440 | reader :: (Monad eff) => (r -> a) -> ReaderT r eff a 441 | reader f = ReaderT $ \r -> return $ f r 442 | ``` 443 | 444 | Now our actual state might look something like this: 445 | 446 | ``` {.sourceCode .literate .haskell} 447 | data MyEnv = MyEnv 448 | { tier :: Tier 449 | , featureFlag :: Bool 450 | } 451 | 452 | data Tier = Test | Production 453 | 454 | env :: Tier -> MyEnv 455 | env t = MyEnv 456 | { tier = t 457 | , featureFlag = False 458 | } 459 | ``` 460 | 461 | And we can augment `WebDriverT` with our reader transformer. 462 | 463 | ``` {.sourceCode .literate .haskell} 464 | type MyWebDriver eff a = WebDriverT (ReaderT MyEnv eff) a 465 | ``` 466 | 467 | Now we can build values in `MyWebDriver` using the same API as before, 468 | using the extra features of the inner monad with `liftWebDriverT`. 469 | 470 | ``` {.sourceCode .literate .haskell} 471 | custom_environment :: (Monad eff) => MyWebDriver eff () 472 | custom_environment = do 473 | theTier <- liftWebDriverT $ reader tier 474 | case theTier of 475 | Test -> navigateTo "http://google.com" 476 | Production -> navigateTo "http://yahoo.com" 477 | ``` 478 | 479 | To actually run sessions using our custom monad stack we need to make a 480 | few adjustments. First, we use `execWebDriverT` instead of 481 | `execWebDriver`. This function takes one extra argument corresponding to 482 | `lift` for the inner transformer. 483 | 484 | Second, we need to supply a function that "runs" the inner transformer 485 | (in this case `ReaderT eff a`) to `IO`. 486 | 487 | ``` {.sourceCode .literate .haskell} 488 | execReaderT :: r -> ReaderT r IO a -> IO a 489 | execReaderT r x = runReaderT x r 490 | ``` 491 | 492 | Running our custom WebDriver monad is then straightforward. 493 | 494 | ``` {.sourceCode .literate .haskell} 495 | example4 :: Tier -> IO () 496 | example4 t = do 497 | execReaderT (env t) $ 498 | execWebDriverT defaultWebDriverConfig liftReaderT 499 | (runIsolated_ defaultFirefoxCapabilities custom_environment) 500 | return () 501 | ``` 502 | 503 | Try it out with 504 | 505 | example4 Test 506 | example4 Production 507 | 508 | We can similarly use a custom inner monad to check assertions and with 509 | the tasty integration; there are analogous `debugWebDriverT` and 510 | `testCaseT` functions. 511 | 512 | `ReaderT` is just one option for the inner monad transformer. We could 513 | put mutable state, delimited continuations, or even another HTTP API 514 | monad in there. Use your imagination! 515 | 516 | Debugging 517 | --------- 518 | 519 | Running browser sessions is one thing, but writing and debugging them is 520 | another. `webdriver-w3c` has some tools for dealing with this as well. 521 | Besides the log, which gives a thorough account of what happened, we can 522 | include breakpoints in our code. When breakpoints are activated, they 523 | stop the session and give us a chance to poke around the browser before 524 | moving on. 525 | 526 | Here's a simple example. 527 | 528 | ``` {.sourceCode .literate .haskell} 529 | stop_and_smell_the_ajax :: (Monad eff) => WebDriver eff () 530 | stop_and_smell_the_ajax = do 531 | breakpointsOn 532 | 533 | navigateTo "https://google.com" 534 | 535 | breakpoint "Just checking" 536 | 537 | navigateTo "https://mozilla.org" 538 | 539 | breakpoint "are we there yet" 540 | ``` 541 | 542 | We can run this with `example5`: 543 | 544 | ``` {.sourceCode .literate .haskell} 545 | example5 :: IO () 546 | example5 = do 547 | execWebDriver defaultWebDriverConfig 548 | (runIsolated_ defaultFirefoxCapabilities stop_and_smell_the_ajax) 549 | return () 550 | ``` 551 | 552 | The basic `breakpoint` command gives the option to continue, throw an 553 | error, dump the current state and environment to stdout, and turn 554 | breakpoints off. A fancier version, `breakpointWith`, takes an 555 | additional argument letting us trigger a custom action. 556 | 557 | Where to Learn More 558 | ------------------- 559 | 560 | For now the canonical documentation is the haddock annotations on 561 | [Hackage](https://hackage.haskell.org/package/webdriver-w3c). 562 | -------------------------------------------------------------------------------- /makefile: -------------------------------------------------------------------------------- 1 | docs: 2 | pandoc app/Main.lhs -f markdown+lhs -t markdown -o doc/Tutorial.md 3 | pandoc app/TastyDemo.lhs -f markdown+lhs -t markdown -o doc/TastyDemo.md 4 | 5 | test: 6 | ./dev/run-tests.sh 7 | 8 | test-compat: 9 | ./dev/test-compat.sh 10 | 11 | demo: 12 | ./dev/run-demo.sh 13 | 14 | stress: 15 | ./dev/run-parallel-stress-test.sh 16 | 17 | .PHONY: docs test test-compat demo stress 18 | -------------------------------------------------------------------------------- /src/Test/Tasty/WebDriver/Config.hs: -------------------------------------------------------------------------------- 1 | {- | 2 | Module : Test.Tasty.WebDriver.Config 3 | Description : Helpers for parsing config files. 4 | Copyright : 2018, Automattic, Inc. 5 | License : GPL-3 6 | Maintainer : Nathan Bloomfield (nbloomf@gmail.com) 7 | Stability : experimental 8 | Portability : POSIX 9 | -} 10 | 11 | {-# LANGUAGE RecordWildCards, OverloadedStrings #-} 12 | module Test.Tasty.WebDriver.Config ( 13 | DriverName(..) 14 | , RemoteEndPool(..) 15 | , addRemoteEndForDriver 16 | , getRemoteEndForDriver 17 | , RemoteEnd(..) 18 | 19 | -- * Parsing 20 | , parseRemoteEnd 21 | , parseRemoteEndConfig 22 | , parseRemoteEndOption 23 | 24 | , parseOptionWithArgument 25 | ) where 26 | 27 | import Data.List 28 | ( isPrefixOf, nub ) 29 | import qualified Data.Map.Strict as MS 30 | ( fromListWith, insert, lookup, adjust, fromList, unionWith, Map ) 31 | import Data.Typeable 32 | ( Typeable ) 33 | import Data.Text (Text) 34 | import qualified Data.Text as T 35 | import qualified Data.Text.IO as T 36 | import Network.URI 37 | ( URI(..), URIAuth(..), parseURI ) 38 | import Text.Read 39 | ( readMaybe ) 40 | 41 | 42 | 43 | -- | Remote end name. 44 | data DriverName 45 | = Geckodriver 46 | | Chromedriver 47 | deriving (Eq, Ord, Typeable) 48 | 49 | instance Show DriverName where 50 | show Geckodriver = "geckodriver" 51 | show Chromedriver = "chromedriver" 52 | 53 | -- | Pool of remote end connections per driver. 54 | newtype RemoteEndPool = RemoteEndPool 55 | { freeRemoteEnds :: MS.Map DriverName [RemoteEnd] 56 | } deriving (Eq, Show) 57 | 58 | instance Semigroup RemoteEndPool where 59 | x <> y = RemoteEndPool 60 | { freeRemoteEnds = MS.unionWith (++) (freeRemoteEnds x) (freeRemoteEnds y) 61 | } 62 | 63 | instance Monoid RemoteEndPool where 64 | mempty = RemoteEndPool 65 | { freeRemoteEnds = MS.fromList [] 66 | } 67 | 68 | mappend = (<>) 69 | 70 | -- | Push a remote end to the pool stack for a given driver. 71 | addRemoteEndForDriver :: DriverName -> RemoteEnd -> RemoteEndPool -> RemoteEndPool 72 | addRemoteEndForDriver driver remote pool = RemoteEndPool 73 | { freeRemoteEnds = MS.adjust (remote:) driver $ freeRemoteEnds pool 74 | } 75 | 76 | -- | Attempt to pop a remote end from the pool stack for a given driver. Returns the new pool, whether or not a remote end was popped. Returns a `Just Just` if a remote end was found, a `Just Nothing` if the driver has an empty stack of remotes, and `Nothing` if the pool is undefined for the driver. 77 | getRemoteEndForDriver :: DriverName -> RemoteEndPool -> (RemoteEndPool, Maybe (Maybe RemoteEnd)) 78 | getRemoteEndForDriver driver pool = 79 | case MS.lookup driver (freeRemoteEnds pool) of 80 | Nothing -> (pool, Nothing) 81 | Just z -> case z of 82 | [] -> (pool, Just Nothing) 83 | (r:rs) -> (pool { freeRemoteEnds = MS.insert driver rs $ freeRemoteEnds pool }, Just $ Just r) 84 | 85 | -- | Representation of a remote end connection. 86 | data RemoteEnd = RemoteEnd 87 | { remoteEndHost :: Text -- ^ Scheme, auth, and hostname 88 | , remoteEndPort :: Int 89 | , remoteEndPath :: Text -- ^ Additional path component 90 | } deriving Eq 91 | 92 | instance Show RemoteEnd where 93 | show remote = T.unpack $ T.concat 94 | [ remoteEndHost remote 95 | , ":" 96 | , T.pack $ show $ remoteEndPort remote 97 | , remoteEndPath remote 98 | ] 99 | 100 | -- | Parse a remote end config file. This file consists of 0 or more blocks of the form 101 | -- 102 | -- > DRIVER_NAME 103 | -- > - REMOTE_END_URI 104 | -- > - REMOTE_END_URI 105 | -- 106 | -- where `DRIVER_NAME` is either `geckodriver` or `chromedriver` and each `REMOTE_END_URI` is the uri of a WebDriver remote end, including scheme. Blank lines are ignored. 107 | parseRemoteEndConfig :: Text -> Either Text RemoteEndPool 108 | parseRemoteEndConfig str = do 109 | freeEnds <- fmap (MS.fromListWith (<>)) $ tokenizeRemoteEndConfig $ filter (/= "") $ T.lines str 110 | return RemoteEndPool 111 | { freeRemoteEnds = freeEnds 112 | } 113 | 114 | tokenizeRemoteEndConfig :: [Text] -> Either Text [(DriverName, [RemoteEnd])] 115 | tokenizeRemoteEndConfig ls = case ls of 116 | [] -> return [] 117 | (first:rest) -> do 118 | driver <- case first of 119 | "geckodriver" -> return Geckodriver 120 | "chromedriver" -> return Chromedriver 121 | _ -> Left $ "Unrecognized driver name '" <> first <> "'." 122 | let (remotes, remainder) = span ("- " `T.isPrefixOf`) rest 123 | ends <- mapM (parseRemoteEnd . T.drop 2) remotes 124 | config <- tokenizeRemoteEndConfig remainder 125 | return $ (driver, nub ends) : config 126 | 127 | -- | Parse a remote end command line option. This option consists of 0 or more substrings of the form 128 | -- 129 | -- > DRIVER_NAME: REMOTE_END_URI REMOTE_END_URI ... 130 | -- 131 | -- where `DRIVER_NAME` is either `geckodriver` or `chromedriver` and each `REMOTE_END_URI` is the uri of a WebDriver remote end, including scheme. 132 | parseRemoteEndOption :: Text -> Either Text RemoteEndPool 133 | parseRemoteEndOption str = do 134 | freeEnds <- fmap (MS.fromListWith (<>)) $ tokenizeRemoteEndOption $ T.words str 135 | return RemoteEndPool 136 | { freeRemoteEnds = freeEnds 137 | } 138 | 139 | tokenizeRemoteEndOption :: [Text] -> Either Text [(DriverName, [RemoteEnd])] 140 | tokenizeRemoteEndOption ws = case ws of 141 | [] -> return [] 142 | (first:rest) -> do 143 | driver <- case first of 144 | "geckodriver" -> return Geckodriver 145 | "chromedriver" -> return Chromedriver 146 | _ -> Left $ "Unrecognized driver name '" <> first <> "'." 147 | let (remotes, remainder) = break (`elem` ["geckodriver","chromedriver"]) rest 148 | ends <- mapM parseRemoteEnd remotes 149 | option <- tokenizeRemoteEndOption remainder 150 | return $ (driver, nub ends) : option 151 | 152 | -- | Parse a single remote end URI. Must include the scheme (http:// or https://) even though this is redundant. 153 | parseRemoteEnd :: Text -> Either Text RemoteEnd 154 | parseRemoteEnd str = case parseURI $ T.unpack str of 155 | Nothing -> Left $ "Could not parse remote end URI '" <> str <> "'." 156 | Just URI{..} -> case uriAuthority of 157 | Nothing -> Left $ "Error parsing authority for URI '" <> str <> "'." 158 | Just URIAuth{..} -> case uriPort of 159 | "" -> Right RemoteEnd 160 | { remoteEndHost = T.pack $ uriUserInfo <> uriRegName 161 | , remoteEndPort = 4444 162 | , remoteEndPath = T.pack uriPath 163 | } 164 | ':' : ds -> case readMaybe ds of 165 | Nothing -> Left $ "Error parsing port for URI '" <> str <> "'." 166 | Just k -> Right RemoteEnd 167 | { remoteEndHost = T.pack $ uriUserInfo <> uriRegName 168 | , remoteEndPort = k 169 | , remoteEndPath = T.pack uriPath 170 | } 171 | _ -> Left $ "Unexpected port '" <> T.pack uriPort <> "' in URI '" <> str <> "'." 172 | 173 | 174 | -- | Helper function for parsing command line options with a required argument. Assumes long-form option names starting with a hyphen. Note the return type; @Just Nothing@ indicates that the option was not present, while @Nothing@ indicates that the option was present but its required argument was not. 175 | parseOptionWithArgument 176 | :: Text -- ^ Option to parse for, including hyphen(s). 177 | -> [Text] -- ^ List of command line arguments. 178 | -> Maybe (Maybe Text) 179 | parseOptionWithArgument option args = case args of 180 | (opt:arg:rest) -> if opt == option 181 | then case T.uncons arg of 182 | Just (c,cs) -> if c == '-' then Nothing else Just (Just arg) 183 | Nothing -> Just (Just arg) 184 | else parseOptionWithArgument option (arg:rest) 185 | _ -> Just Nothing 186 | -------------------------------------------------------------------------------- /src/Web/Api/WebDriver.hs: -------------------------------------------------------------------------------- 1 | {- | 2 | Module : Web.Api.WebDriver 3 | Description : A monad for expressing WebDriver interactions. 4 | Copyright : 2018, Automattic, Inc. 5 | License : GPL-3 6 | Maintainer : Nathan Bloomfield (nbloomf@gmail.com) 7 | Stability : experimental 8 | Portability : POSIX 9 | -} 10 | 11 | module Web.Api.WebDriver ( 12 | module Web.Api.WebDriver.Assert 13 | , module Web.Api.WebDriver.Classes 14 | , module Web.Api.WebDriver.Endpoints 15 | , module Web.Api.WebDriver.Helpers 16 | , module Web.Api.WebDriver.Monad 17 | , module Web.Api.WebDriver.Types 18 | , module Web.Api.WebDriver.Types.Keyboard 19 | , module Web.Api.WebDriver.Uri 20 | ) where 21 | 22 | import Web.Api.WebDriver.Assert 23 | import Web.Api.WebDriver.Classes 24 | import Web.Api.WebDriver.Endpoints 25 | import Web.Api.WebDriver.Helpers 26 | import Web.Api.WebDriver.Monad 27 | import Web.Api.WebDriver.Types 28 | import Web.Api.WebDriver.Types.Keyboard 29 | import Web.Api.WebDriver.Uri 30 | -------------------------------------------------------------------------------- /src/Web/Api/WebDriver/Assert.hs: -------------------------------------------------------------------------------- 1 | {- | 2 | Module : Web.Api.WebDriver.Assert 3 | Description : Mini language for making falsifiable assertions. 4 | Copyright : 2018, Automattic, Inc. 5 | License : GPL-3 6 | Maintainer : Nathan Bloomfield (nbloomf@gmail.com) 7 | Stability : experimental 8 | Portability : POSIX 9 | 10 | In this module we define assertions as first class objects and some helper functions for creating and manipulating them. 11 | -} 12 | 13 | {-# LANGUAGE OverloadedStrings, RecordWildCards #-} 14 | module Web.Api.WebDriver.Assert ( 15 | -- * Assertions 16 | Assertion() 17 | , success 18 | , failure 19 | , AssertionStatement(..) 20 | , AssertionComment(..) 21 | , AssertionResult() 22 | , isSuccess 23 | , printAssertion 24 | 25 | -- * The `Assert` Class 26 | , Assert(..) 27 | 28 | -- * Assertion Summaries 29 | , AssertionSummary(..) 30 | , summarize 31 | , summarizeAll 32 | , printSummary 33 | , numAssertions 34 | 35 | -- * Basic Assertions 36 | , assertSuccessIf 37 | , assertSuccess 38 | , assertFailure 39 | , assertTrue 40 | , assertFalse 41 | , assertEqual 42 | , assertNotEqual 43 | , assertIsSubstring 44 | , assertIsNotSubstring 45 | , assertIsNamedSubstring 46 | , assertIsNotNamedSubstring 47 | ) where 48 | 49 | import Data.List 50 | ( isInfixOf ) 51 | import Data.String 52 | ( IsString, fromString ) 53 | import Data.Text (Text) 54 | import qualified Data.Text as T 55 | import qualified Data.Text.IO as T 56 | import Test.QuickCheck 57 | ( Arbitrary(..) ) 58 | 59 | 60 | 61 | -- | An `Assertion` consists of the following: 62 | -- 63 | -- * A human-readable statement being asserted, which may be either true or false. 64 | -- * A result (either success or failure). 65 | -- * A comment, representing /why/ the assertion was made, to assist in debugging. 66 | -- 67 | -- To construct assertions outside this module, use `success` and `failure`. 68 | 69 | data Assertion = Assertion 70 | { assertionStatement :: AssertionStatement 71 | , assertionComment :: AssertionComment 72 | , assertionResult :: AssertionResult 73 | } deriving (Eq, Show) 74 | 75 | 76 | 77 | -- | Human-readable statement which may be true or false. 78 | newtype AssertionStatement = AssertionStatement 79 | { theAssertionStatement :: Text 80 | } deriving Eq 81 | 82 | instance Show AssertionStatement where 83 | show = T.unpack . theAssertionStatement 84 | 85 | instance IsString AssertionStatement where 86 | fromString = AssertionStatement . T.pack 87 | 88 | instance Arbitrary AssertionStatement where 89 | arbitrary = AssertionStatement <$> (fmap T.pack arbitrary) 90 | 91 | 92 | 93 | -- | Human-readable explanation for why an assertion is made. 94 | newtype AssertionComment = AssertionComment 95 | { theAssertionComment :: Text 96 | } deriving Eq 97 | 98 | instance Show AssertionComment where 99 | show = T.unpack . theAssertionComment 100 | 101 | instance IsString AssertionComment where 102 | fromString = AssertionComment . T.pack 103 | 104 | instance Arbitrary AssertionComment where 105 | arbitrary = AssertionComment <$> (fmap T.pack arbitrary) 106 | 107 | 108 | 109 | -- | Type representing the result (success or failure) of an evaluated assertion. 110 | data AssertionResult 111 | = AssertSuccess | AssertFailure 112 | deriving (Eq, Show) 113 | 114 | instance Arbitrary AssertionResult where 115 | arbitrary = do 116 | p <- arbitrary 117 | return $ if p then AssertSuccess else AssertFailure 118 | 119 | -- | Detects successful assertions. 120 | isSuccess :: Assertion -> Bool 121 | isSuccess a = AssertSuccess == assertionResult a 122 | 123 | 124 | 125 | -- | Basic string representation of an assertion. 126 | printAssertion :: Assertion -> Text 127 | printAssertion Assertion{..} = 128 | case assertionResult of 129 | AssertSuccess -> 130 | T.unwords 131 | [ "\x1b[1;32mValid Assertion\x1b[0;39;49m" 132 | , "\nassertion: " <> theAssertionStatement assertionStatement 133 | , "\ncomment: " <> theAssertionComment assertionComment 134 | ] 135 | AssertFailure -> 136 | T.unwords 137 | [ "\x1b[1;31mInvalid Assertion\x1b[0;39;49m" 138 | , "\nassertion: " <> theAssertionStatement assertionStatement 139 | , "\ncomment: " <> theAssertionComment assertionComment 140 | ] 141 | 142 | 143 | 144 | -- | Construct a successful assertion. 145 | success 146 | :: AssertionStatement -- ^ Statement being asserted (the /what/) 147 | -> AssertionComment -- ^ An additional comment (the /why/) 148 | -> Assertion 149 | success statement comment = Assertion 150 | { assertionStatement = statement 151 | , assertionComment = comment 152 | , assertionResult = AssertSuccess 153 | } 154 | 155 | -- | Construct a failed assertion. 156 | failure 157 | :: AssertionStatement -- ^ Statement being asserted (the /what/) 158 | -> AssertionComment -- ^ An additional comment (the /why/) 159 | -> Assertion 160 | failure statement comment = Assertion 161 | { assertionStatement = statement 162 | , assertionComment = comment 163 | , assertionResult = AssertFailure 164 | } 165 | 166 | 167 | 168 | -- | Assertions are made and evaluated inside some context, represented by the `Assert` class. 169 | class Assert m where 170 | -- | Make an assertion. Typically @m@ is a monad, and the `Assert` instance handles the assertion in @m@ by e.g. logging it, changing state, etc. 171 | assert :: Assertion -> m () 172 | 173 | 174 | 175 | -- | Generic boolean assertion; asserts success if @Bool@ is true and failure otherwise. 176 | assertSuccessIf 177 | :: (Monad m, Assert m) 178 | => Bool 179 | -> AssertionStatement -- ^ Statement being asserted (the /what/) 180 | -> AssertionComment -- ^ An additional comment (the /why/) 181 | -> m () 182 | assertSuccessIf p statement comment = 183 | assert $ (if p then success else failure) statement comment 184 | 185 | -- | Assertion that always succeeds. 186 | assertSuccess 187 | :: (Monad m, Assert m) 188 | => AssertionComment -- ^ An additional comment (the /why/) 189 | -> m () 190 | assertSuccess = assertSuccessIf True (AssertionStatement "Success!") 191 | 192 | -- | Assertion that always fails. 193 | assertFailure 194 | :: (Monad m, Assert m) 195 | => AssertionComment -- ^ An additional comment (the /why/) 196 | -> m () 197 | assertFailure = assertSuccessIf False (AssertionStatement "Failure :(") 198 | 199 | -- | Succeeds if @Bool@ is `True`. 200 | assertTrue 201 | :: (Monad m, Assert m) 202 | => Bool 203 | -> AssertionComment -- ^ An additional comment (the /why/) 204 | -> m () 205 | assertTrue p = assertSuccessIf p 206 | (AssertionStatement $ T.pack (show p) <> " is True") 207 | 208 | -- | Succeeds if @Bool@ is `False`. 209 | assertFalse 210 | :: (Monad m, Assert m) 211 | => Bool 212 | -> AssertionComment -- ^ An additional comment (the /why/) 213 | -> m () 214 | assertFalse p = assertSuccessIf (not p) 215 | (AssertionStatement $ T.pack (show p) <> " is False") 216 | 217 | -- | Succeeds if the given @t@s are equal according to their `Eq` instance. 218 | assertEqual 219 | :: (Monad m, Assert m, Eq t, Show t) 220 | => t 221 | -> t 222 | -> AssertionComment -- ^ An additional comment (the /why/) 223 | -> m () 224 | assertEqual x y = assertSuccessIf (x == y) 225 | (AssertionStatement $ 226 | T.pack (show x) <> " is equal to " <> T.pack (show y)) 227 | 228 | -- | Succeeds if the given @t@s are not equal according to their `Eq` instance. 229 | assertNotEqual 230 | :: (Monad m, Assert m, Eq t, Show t) 231 | => t 232 | -> t 233 | -> AssertionComment -- ^ An additional comment (the /why/) 234 | -> m () 235 | assertNotEqual x y = assertSuccessIf (x /= y) 236 | (AssertionStatement $ T.pack (show x) <> " is not equal to " <> T.pack (show y)) 237 | 238 | -- | Succeeds if the first list is an infix of the second, according to their `Eq` instance. 239 | assertIsSubstring 240 | :: (Monad m, Assert m) 241 | => Text 242 | -> Text 243 | -> AssertionComment -- ^ An additional comment (the /why/) 244 | -> m () 245 | assertIsSubstring x y = assertSuccessIf (T.isInfixOf x y) 246 | (AssertionStatement $ T.pack (show x) <> " is a substring of " <> T.pack (show y)) 247 | 248 | -- | Succeeds if the first list is not an infix of the second, according to their `Eq` instance. 249 | assertIsNotSubstring 250 | :: (Monad m, Assert m) 251 | => Text 252 | -> Text 253 | -> AssertionComment -- ^ An additional comment (the /why/) 254 | -> m () 255 | assertIsNotSubstring x y = assertSuccessIf (not $ T.isInfixOf x y) 256 | (AssertionStatement $ T.pack (show x) <> " is not a substring of " <> T.pack (show y)) 257 | 258 | -- | Succeeds if the first list is an infix of the second, named list, according to their `Eq` instance. This is similar to `assertIsSubstring`, except that the "name" of the second list argument is used in reporting failures. Handy if the second list is very large -- say the source of a webpage. 259 | assertIsNamedSubstring 260 | :: (Monad m, Assert m) 261 | => Text 262 | -> (Text,Text) 263 | -> AssertionComment -- ^ An additional comment (the /why/) 264 | -> m () 265 | assertIsNamedSubstring x (y,name) = assertSuccessIf (T.isInfixOf x y) 266 | (AssertionStatement $ T.pack (show x) <> " is a substring of " <> name) 267 | 268 | -- | Succeeds if the first list is not an infix of the second, named list, according to their `Eq` instance. This is similar to `assertIsNotSubstring`, except that the "name" of the second list argument is used in reporting failures. Handy if the second list is very large -- say the source of a webpage. 269 | assertIsNotNamedSubstring 270 | :: (Monad m, Assert m) 271 | => Text 272 | -> (Text,Text) 273 | -> AssertionComment -- ^ An additional comment (the /why/) 274 | -> m () 275 | assertIsNotNamedSubstring x (y,name) = assertSuccessIf (not $ T.isInfixOf x y) 276 | (AssertionStatement $ T.pack (show x) <> " is not a substring of " <> name) 277 | 278 | 279 | 280 | -- | `Assertion`s are the most granular kind of "test" this library deals with. Typically we'll be interested in sets of many assertions. A single test case will include one or more assertions, which for reporting purposes we'd like to summarize. The summary for a list of assertions will include the number of successes, the number of failures, and the actual failures. Modeled this way assertion summaries form a monoid, which is handy. 281 | 282 | data AssertionSummary = AssertionSummary 283 | { numSuccesses :: Integer 284 | , numFailures :: Integer 285 | , failures :: [Assertion] 286 | , successes :: [Assertion] 287 | } deriving (Eq, Show) 288 | 289 | instance Semigroup AssertionSummary where 290 | x <> y = AssertionSummary 291 | { numSuccesses = numSuccesses x + numSuccesses y 292 | , numFailures = numFailures x + numFailures y 293 | , failures = failures x ++ failures y 294 | , successes = successes x ++ successes y 295 | } 296 | 297 | instance Monoid AssertionSummary where 298 | mempty = AssertionSummary 0 0 [] [] 299 | 300 | mappend = (<>) 301 | 302 | -- | Summarize a single assertion. 303 | summary :: Assertion -> AssertionSummary 304 | summary x = AssertionSummary 305 | { numSuccesses = if isSuccess x then 1 else 0 306 | , numFailures = if isSuccess x then 0 else 1 307 | , failures = if isSuccess x then [] else [x] 308 | , successes = if isSuccess x then [x] else [] 309 | } 310 | 311 | -- | Summarize a list of `Assertion`s. 312 | summarize :: [Assertion] -> AssertionSummary 313 | summarize = mconcat . map summary 314 | 315 | -- | Summarize a list of `AssertionSummary`s. 316 | summarizeAll :: [AssertionSummary] -> AssertionSummary 317 | summarizeAll = mconcat 318 | 319 | -- | Very basic string representation of an `AssertionSummary`. 320 | printSummary :: AssertionSummary -> IO () 321 | printSummary AssertionSummary{..} = do 322 | mapM_ (T.putStrLn . printAssertion) failures 323 | putStrLn $ "Assertions: " ++ show (numSuccesses + numFailures) 324 | putStrLn $ "Failures: " ++ show numFailures 325 | 326 | -- | Total number of assertions made. 327 | numAssertions :: AssertionSummary -> Integer 328 | numAssertions x = numSuccesses x + numFailures x 329 | -------------------------------------------------------------------------------- /src/Web/Api/WebDriver/Classes.hs: -------------------------------------------------------------------------------- 1 | {- | 2 | Module : Web.Api.WebDriver.Classes 3 | Description : Utility typeclasses 4 | Copyright : 2018, Automattic, Inc. 5 | License : GPL-3 6 | Maintainer : Nathan Bloomfield (nbloomf@gmail.com) 7 | Stability : experimental 8 | Portability : POSIX 9 | -} 10 | 11 | module Web.Api.WebDriver.Classes ( 12 | HasElementRef(..) 13 | , HasContextId(..) 14 | ) where 15 | 16 | import Web.Api.WebDriver.Types 17 | 18 | -- | Types which carry a /web element reference/ as described in https://www.w3.org/TR/webdriver/#elements. 19 | class HasElementRef t where 20 | elementRefOf :: t -> ElementRef 21 | 22 | instance HasElementRef ElementRef where 23 | elementRefOf = id 24 | 25 | 26 | 27 | -- | Types which carry a /window handle/ as described in https://www.w3.org/TR/webdriver/#command-contexts. 28 | class HasContextId t where 29 | contextIdOf :: t -> ContextId 30 | 31 | instance HasContextId ContextId where 32 | contextIdOf = id 33 | -------------------------------------------------------------------------------- /src/Web/Api/WebDriver/Helpers.hs: -------------------------------------------------------------------------------- 1 | {- | 2 | Module : Web.Api.WebDriver.Helpers 3 | Description : Higher level WebDriver utilities. 4 | Copyright : 2018, Automattic, Inc. 5 | License : GPL-3 6 | Maintainer : Nathan Bloomfield (nbloomf@gmail.com) 7 | Stability : experimental 8 | Portability : POSIX 9 | -} 10 | 11 | {-# LANGUAGE OverloadedStrings #-} 12 | module Web.Api.WebDriver.Helpers ( 13 | -- * Data 14 | writeDataFile 15 | , readDataFile 16 | , writeJsonFile 17 | , readJsonFile 18 | 19 | -- * Secrets 20 | , stashCookies 21 | , loadCookies 22 | 23 | -- * Actions 24 | , press 25 | , typeString 26 | ) where 27 | 28 | import Control.Monad.Trans.Class 29 | ( MonadTrans(..) ) 30 | import qualified Data.Aeson as Aeson 31 | ( encode, ToJSON(..), Value ) 32 | import Data.ByteString.Lazy 33 | ( ByteString, fromChunks ) 34 | import qualified Data.ByteString.Lazy.Char8 as BS 35 | ( pack ) 36 | import qualified Data.Digest.Pure.SHA as SHA 37 | ( showDigest, sha1 ) 38 | import Data.Text (Text) 39 | import qualified Data.Text as T 40 | import qualified Data.Text.Encoding as T 41 | 42 | import Web.Api.WebDriver.Endpoints 43 | import Web.Api.WebDriver.Monad 44 | import Web.Api.WebDriver.Types 45 | import Web.Api.WebDriver.Types.Keyboard 46 | 47 | 48 | 49 | 50 | 51 | -- | Save all cookies for the current domain to a file. 52 | stashCookies 53 | :: (Monad eff, Monad (t eff), MonadTrans t) 54 | => Text -- ^ Passed through SHA1, and the digest is used as the filename. 55 | -> WebDriverTT t eff () 56 | stashCookies string = 57 | let file = SHA.showDigest $ SHA.sha1 $ fromChunks [T.encodeUtf8 string] in 58 | getAllCookies >>= writeCookieFile file 59 | 60 | 61 | -- | Load cookies from a file saved with `stashCookies`. Returns `False` if the cookie file is missing or cannot be read. 62 | loadCookies 63 | :: (Monad eff, Monad (t eff), MonadTrans t) 64 | => Text -- ^ Passed through SHA1, and the digest is used as the filename. 65 | -> WebDriverTT t eff Bool 66 | loadCookies string = do 67 | let file = SHA.showDigest $ SHA.sha1 $ fromChunks [T.encodeUtf8 string] 68 | contents <- readCookieFile file 69 | case contents of 70 | Nothing -> return False 71 | Just cs -> do 72 | mapM_ addCookie cs 73 | return True 74 | 75 | 76 | -- | Write cookies to a file under the secrets path. 77 | writeCookieFile 78 | :: (Monad eff, Monad (t eff), MonadTrans t) 79 | => FilePath -- ^ File path; relative to @$DATA_PATH\/secrets\/cookies\/@ 80 | -> [Cookie] 81 | -> WebDriverTT t eff () 82 | writeCookieFile file cookies = do 83 | path <- fromEnv (_dataPath . _env) 84 | let fullpath = path ++ "/secrets/cookies/" ++ file 85 | writeFilePath fullpath (Aeson.encode cookies) 86 | 87 | 88 | -- | Read cookies from a file stored with `writeCookieFile`. Returns `Nothing` if the file does not exist. 89 | readCookieFile 90 | :: (Monad eff, Monad (t eff), MonadTrans t) 91 | => FilePath -- ^ File path; relative to @$DATA_PATH\/secrets\/cookies\/@ 92 | -> WebDriverTT t eff (Maybe [Cookie]) 93 | readCookieFile file = do 94 | path <- fromEnv (_dataPath . _env) 95 | let fullpath = path ++ "/secrets/cookies/" ++ file 96 | cookieFileExists <- fileExists fullpath 97 | if cookieFileExists 98 | then readFilePath fullpath 99 | >>= parseJson 100 | >>= constructFromJson 101 | >>= mapM constructFromJson 102 | >>= (return . Just) 103 | else return Nothing 104 | 105 | 106 | 107 | -- | Write a `ByteString` to the data directory 108 | writeDataFile 109 | :: (Monad eff, Monad (t eff), MonadTrans t) 110 | => FilePath -- ^ File path, relative to @$DATA_PATH@, with leading slash 111 | -> ByteString 112 | -> WebDriverTT t eff () 113 | writeDataFile file contents = do 114 | path <- fromEnv (_dataPath . _env) 115 | writeFilePath (path ++ file) contents 116 | 117 | -- | Read a `ByteString` from the data directory 118 | readDataFile 119 | :: (Monad eff, Monad (t eff), MonadTrans t) 120 | => FilePath -- ^ File path, relative to @$DATA_PATH@, with leading slash 121 | -> WebDriverTT t eff ByteString 122 | readDataFile file = do 123 | path <- fromEnv (_dataPath . _env) 124 | readFilePath $ path ++ file 125 | 126 | 127 | 128 | -- | Write JSON to the data directory 129 | writeJsonFile 130 | :: (Monad eff, Monad (t eff), MonadTrans t, Aeson.ToJSON a) 131 | => FilePath -- ^ File path, relative to @$DATA_PATH@, with leading slash 132 | -> a 133 | -> WebDriverTT t eff () 134 | writeJsonFile file a = do 135 | path <- fromEnv (_dataPath . _env) 136 | writeFilePath (path ++ file) (Aeson.encode $ Aeson.toJSON a) 137 | 138 | -- | Read a JSON `Value` from the data directory 139 | readJsonFile 140 | :: (Monad eff, Monad (t eff), MonadTrans t) 141 | => FilePath -- ^ File path, relative to @$DATA_PATH@, with leading slash 142 | -> WebDriverTT t eff Aeson.Value 143 | readJsonFile file = do 144 | path <- fromEnv (_dataPath . _env) 145 | readFilePath (path ++ file) >>= parseJson 146 | 147 | 148 | 149 | -- | `KeyDownAction` with the given `Char`. 150 | keypress :: Char -> ActionItem 151 | keypress x = emptyActionItem 152 | { _actionType = Just KeyDownAction 153 | , _actionValue = Just $ T.singleton x 154 | } 155 | 156 | 157 | -- | Simulate pressing a `Key`. 158 | press :: Key -> Action 159 | press key = emptyAction 160 | { _inputSourceType = Just KeyInputSource 161 | , _inputSourceId = Just "kbd" 162 | , _actionItems = [keypress (keyToChar key)] 163 | } 164 | 165 | 166 | -- | Simulate typing some text. 167 | typeString :: Text -> Action 168 | typeString x = emptyAction 169 | { _inputSourceType = Just KeyInputSource 170 | , _inputSourceId = Just "kbd" 171 | , _actionItems = map keypress $ T.unpack x 172 | } 173 | -------------------------------------------------------------------------------- /src/Web/Api/WebDriver/Monad.hs: -------------------------------------------------------------------------------- 1 | {- | 2 | Module : Web.Api.WebDriver.Monad 3 | Description : A WebDriver session monad. 4 | Copyright : 2018, Automattic, Inc. 5 | License : GPL-3 6 | Maintainer : Nathan Bloomfield (nbloomf@gmail.com) 7 | Stability : experimental 8 | Portability : POSIX 9 | 10 | A monad transformer for building WebDriver sessions. 11 | -} 12 | 13 | {-# 14 | LANGUAGE 15 | CPP, 16 | GADTs, 17 | Rank2Types, 18 | KindSignatures, 19 | RecordWildCards, 20 | OverloadedStrings 21 | #-} 22 | 23 | module Web.Api.WebDriver.Monad ( 24 | WebDriverT 25 | , execWebDriverT 26 | , debugWebDriverT 27 | , checkWebDriverT 28 | 29 | , WebDriverTT() 30 | , execWebDriverTT 31 | , debugWebDriverTT 32 | , checkWebDriverTT 33 | , liftWebDriverTT 34 | 35 | , evalWDAct 36 | , Http.evalIO 37 | , evalWDActMockIO 38 | , Http.evalMockIO 39 | 40 | -- * Config 41 | , WebDriverConfig(..) 42 | , defaultWebDriverConfig 43 | , defaultWebDriverState 44 | , defaultWebDriverEnvironment 45 | , defaultWDEnv 46 | , defaultWebDriverLogOptions 47 | 48 | -- * API 49 | , fromState 50 | , modifyState 51 | , fromEnv 52 | , comment 53 | , wait 54 | , logDebug 55 | , logNotice 56 | , throwError 57 | , throwJsonError 58 | , throwHttpException 59 | , throwIOException 60 | , expect 61 | , expectIs 62 | , assert 63 | , catchError 64 | , catchJsonError 65 | , catchHttpException 66 | , catchIOException 67 | , catchAnyError 68 | , parseJson 69 | , lookupKeyJson 70 | , constructFromJson 71 | , httpGet 72 | , httpSilentGet 73 | , httpPost 74 | , httpSilentPost 75 | , httpDelete 76 | , httpSilentDelete 77 | , hPutStrLn 78 | , hPutStrLnBlocking 79 | , getStrLn 80 | , promptForString 81 | , promptForSecret 82 | , readFilePath 83 | , writeFilePath 84 | , fileExists 85 | , breakpointsOn 86 | , breakpointsOff 87 | , breakpoint 88 | , breakpointWith 89 | 90 | -- * Types 91 | , Http.E() 92 | , Http.JsonError(..) 93 | , WDError(..) 94 | , Http.R(..) 95 | , Http.LogOptions(..) 96 | , WDEnv(..) 97 | , ResponseFormat(..) 98 | , ApiVersion(..) 99 | , Outcome(..) 100 | , Http.Url 101 | , Http.HttpResponse(..) 102 | , WDLog(..) 103 | , Http.P(..) 104 | , WDAct(..) 105 | , Http.S(..) 106 | , WDState(..) 107 | , BreakpointSetting(..) 108 | 109 | -- * Logs 110 | , getAssertions 111 | , Http.logEntries 112 | , Http.printHttpLogs 113 | , Http.basicLogEntryPrinter 114 | ) where 115 | 116 | 117 | 118 | #if MIN_VERSION_base(4,9,0) 119 | import Prelude hiding (fail, readFile, writeFile, putStrLn) 120 | #else 121 | import Prelude hiding (readFile, writeFile, putStrLn) 122 | #endif 123 | 124 | import Control.Concurrent.MVar 125 | ( MVar ) 126 | import Control.Exception 127 | ( IOException, try ) 128 | import Control.Lens 129 | ( (^.), (^?) ) 130 | import Control.Monad 131 | ( ap ) 132 | import Control.Monad.IO.Class 133 | ( MonadIO(..) ) 134 | import Control.Monad.Trans.Class 135 | ( MonadTrans(..) ) 136 | import Control.Monad.Trans.Identity 137 | ( IdentityT(..) ) 138 | import Data.Aeson 139 | ( Value(), Result(Success), toJSON, (.=), FromJSON, fromJSON, object ) 140 | import Data.Aeson.Encode.Pretty 141 | ( encodePretty ) 142 | import Data.Aeson.Lens 143 | ( key, _Value, _String ) 144 | import qualified Data.ByteString.Char8 as SC 145 | ( unpack ) 146 | import Data.ByteString.Lazy 147 | ( ByteString, readFile, writeFile, toStrict, fromStrict ) 148 | import qualified Data.ByteString.Lazy.Char8 as LC 149 | ( unpack, pack ) 150 | import Data.List 151 | ( intercalate ) 152 | import Data.Text 153 | ( unpack, Text ) 154 | import qualified Data.Text as T 155 | import qualified Data.Text.IO as T 156 | import qualified Data.Text.Encoding as T 157 | import qualified Network.HTTP.Client as N 158 | ( HttpException(..), HttpExceptionContent(..) ) 159 | import Network.Wreq 160 | ( Status, statusMessage, statusCode, responseStatus, defaults ) 161 | import System.Directory 162 | ( doesFileExist ) 163 | import System.IO 164 | ( Handle, hGetLine, hSetEcho, hGetEcho, stdout, stdin ) 165 | import System.IO.Error 166 | ( eofErrorType, doesNotExistErrorType, mkIOError ) 167 | import Test.QuickCheck 168 | ( Property ) 169 | 170 | -- Transitional MonadFail implementation 171 | #if MIN_VERSION_base(4,9,0) 172 | import Control.Monad.Fail 173 | #endif 174 | 175 | import qualified Control.Monad.Script.Http as Http 176 | import qualified Data.MockIO as Mock 177 | import qualified Data.MockIO.FileSystem as FS 178 | 179 | import Web.Api.WebDriver.Types 180 | import Web.Api.WebDriver.Assert 181 | 182 | 183 | 184 | 185 | 186 | -- | Wrapper type around `Http.HttpTT`; a stack of error, reader, writer, state, and prompt monad transformers. 187 | newtype WebDriverTT 188 | (t :: (* -> *) -> * -> *) 189 | (eff :: * -> *) 190 | (a :: *) 191 | = WDT 192 | { unWDT :: Http.HttpTT WDError WDEnv WDLog WDState WDAct t eff a } 193 | 194 | instance 195 | (Monad eff, Monad (t eff), MonadTrans t) 196 | => Functor (WebDriverTT t eff) where 197 | fmap f = WDT . fmap f . unWDT 198 | 199 | instance 200 | (Monad eff, Monad (t eff), MonadTrans t) 201 | => Applicative (WebDriverTT t eff) where 202 | pure = return 203 | (<*>) = ap 204 | 205 | instance 206 | (Monad eff, Monad (t eff), MonadTrans t) 207 | => Monad (WebDriverTT t eff) where 208 | return = WDT . return 209 | (WDT x) >>= f = WDT (x >>= (unWDT . f)) 210 | 211 | instance 212 | (MonadIO eff, MonadIO (t eff), MonadTrans t) 213 | => MonadIO (WebDriverTT t eff) where 214 | liftIO = WDT . Http.liftHttpTT . liftIO 215 | 216 | instance 217 | (Monad eff, MonadTrans t, Monad (t eff), MonadFail (t eff)) 218 | => MonadFail (WebDriverTT t eff) where 219 | fail = WDT . fail 220 | 221 | -- | Lift a value from the inner transformed monad 222 | liftWebDriverTT 223 | :: (Monad eff, Monad (t eff), MonadTrans t) 224 | => t eff a -> WebDriverTT t eff a 225 | liftWebDriverTT = WDT . Http.liftHttpTT 226 | 227 | -- | Type representing configuration settings for a WebDriver session 228 | data WebDriverConfig eff = WDConfig 229 | { _initialState :: Http.S WDState 230 | , _environment :: Http.R WDError WDLog WDEnv 231 | , _evaluator :: forall a. Http.P WDAct a -> eff a 232 | } 233 | 234 | -- | Default `IO` effects 235 | defaultWebDriverConfig :: WebDriverConfig IO 236 | defaultWebDriverConfig = WDConfig 237 | { _initialState = defaultWebDriverState 238 | , _environment = defaultWebDriverEnvironment 239 | , _evaluator = Http.evalIO evalWDAct 240 | } 241 | 242 | defaultWebDriverState :: Http.S WDState 243 | defaultWebDriverState = Http.S 244 | { Http._httpOptions = defaults 245 | , Http._httpSession = Nothing 246 | , Http._userState = WDState 247 | { _sessionId = Nothing 248 | , _breakpoints = BreakpointsOff 249 | } 250 | } 251 | 252 | defaultWebDriverEnvironment :: Http.R WDError WDLog WDEnv 253 | defaultWebDriverEnvironment = Http.R 254 | { Http._logHandle = stdout 255 | , Http._logLock = Nothing 256 | , Http._logEntryPrinter = Http.basicLogEntryPrinter 257 | , Http._uid = "" 258 | , Http._logOptions = defaultWebDriverLogOptions 259 | , Http._httpErrorInject = promoteHttpResponseError 260 | , Http._env = defaultWDEnv 261 | } 262 | 263 | -- | Uses default geckodriver settings 264 | defaultWDEnv :: WDEnv 265 | defaultWDEnv = WDEnv 266 | { _remoteHostname = "localhost" 267 | , _remotePort = 4444 268 | , _remotePath = "" 269 | , _dataPath = "" 270 | , _responseFormat = SpecFormat 271 | , _apiVersion = CR_2018_03_04 272 | , _stdin = stdin 273 | , _stdout = stdout 274 | } 275 | 276 | -- | Noisy, JSON, in color, without headers. 277 | defaultWebDriverLogOptions :: Http.LogOptions WDError WDLog 278 | defaultWebDriverLogOptions = Http.trivialLogOptions 279 | { Http._logColor = True 280 | , Http._logJson = True 281 | , Http._logHeaders = False 282 | , Http._logSilent = False 283 | , Http._printUserError = printWDError 284 | , Http._printUserLog = printWDLog 285 | } 286 | 287 | 288 | 289 | -- | Execute a `WebDriverTT` session. 290 | execWebDriverTT 291 | :: (Monad eff, Monad (t eff), MonadTrans t) 292 | => WebDriverConfig eff 293 | -> WebDriverTT t eff a 294 | -> t eff (Either (Http.E WDError) a, Http.S WDState, Http.W WDError WDLog) 295 | execWebDriverTT config = Http.execHttpTT 296 | (_initialState config) (_environment config) (_evaluator config) . unWDT 297 | 298 | -- | Execute a `WebDriverTT` session, returning an assertion summary with the result. 299 | debugWebDriverTT 300 | :: (Monad eff, Monad (t eff), MonadTrans t) 301 | => WebDriverConfig eff 302 | -> WebDriverTT t eff a 303 | -> t eff (Either Text a, AssertionSummary) 304 | debugWebDriverTT config session = do 305 | (result, _, w) <- execWebDriverTT config session 306 | let output = case result of 307 | Right a -> Right a 308 | Left e -> Left $ Http.printError (printWDError True) e 309 | return (output, summarize $ getAssertions $ Http.logEntries w) 310 | 311 | -- | For testing with QuickCheck. 312 | checkWebDriverTT 313 | :: (Monad eff, Monad (t eff), MonadTrans t, Show q) 314 | => WebDriverConfig eff 315 | -> (t eff (Either (Http.E WDError) a, Http.S WDState, Http.W WDError WDLog) -> IO q) -- ^ Condense to `IO` 316 | -> (q -> Bool) -- ^ Result check 317 | -> WebDriverTT t eff a 318 | -> Property 319 | checkWebDriverTT config cond check = 320 | Http.checkHttpTT 321 | (_initialState config) 322 | (_environment config) 323 | (_evaluator config) 324 | cond check . unWDT 325 | 326 | 327 | 328 | 329 | 330 | -- | `WebDriverTT` over `IdentityT`. 331 | type WebDriverT eff a = WebDriverTT IdentityT eff a 332 | 333 | 334 | 335 | -- | Execute a `WebDriverT` session. 336 | execWebDriverT 337 | :: (Monad eff) 338 | => WebDriverConfig eff 339 | -> WebDriverT eff a 340 | -> eff (Either (Http.E WDError) a, Http.S WDState, Http.W WDError WDLog) 341 | execWebDriverT config = runIdentityT . execWebDriverTT config 342 | 343 | -- | Execute a `WebDriverT` session, returning an assertion summary with the result. 344 | debugWebDriverT 345 | :: (Monad eff) 346 | => WebDriverConfig eff 347 | -> WebDriverT eff a 348 | -> eff (Either Text a, AssertionSummary) 349 | debugWebDriverT config session = do 350 | (result, _, w) <- execWebDriverT config session 351 | let output = case result of 352 | Right a -> Right a 353 | Left e -> Left $ Http.printError (printWDError True) e 354 | return (output, summarize $ getAssertions $ Http.logEntries w) 355 | 356 | -- | For testing with QuickCheck 357 | checkWebDriverT 358 | :: (Monad eff, Show q) 359 | => WebDriverConfig eff 360 | -> (eff (Either (Http.E WDError) t, Http.S WDState, Http.W WDError WDLog) -> IO q) -- ^ Condense to `IO` 361 | -> (q -> Bool) -- ^ Result check 362 | -> WebDriverT eff t 363 | -> Property 364 | checkWebDriverT config cond = checkWebDriverTT config (cond . runIdentityT) 365 | 366 | 367 | 368 | -- | Get a computed value from the state 369 | fromState 370 | :: (Monad eff, Monad (t eff), MonadTrans t) 371 | => (Http.S WDState -> a) -> WebDriverTT t eff a 372 | fromState = WDT . Http.gets 373 | 374 | -- | Mutate the state 375 | modifyState 376 | :: (Monad eff, Monad (t eff), MonadTrans t) 377 | => (Http.S WDState -> Http.S WDState) -> WebDriverTT t eff () 378 | modifyState = WDT . Http.modify 379 | 380 | -- | Get a computed value from the environment 381 | fromEnv 382 | :: (Monad eff, Monad (t eff), MonadTrans t) 383 | => (Http.R WDError WDLog WDEnv -> a) -> WebDriverTT t eff a 384 | fromEnv = WDT . Http.reader 385 | 386 | logDebug 387 | :: (Monad eff, Monad (t eff), MonadTrans t) 388 | => WDLog -> WebDriverTT t eff () 389 | logDebug = WDT . Http.logDebug 390 | 391 | logNotice 392 | :: (Monad eff, Monad (t eff), MonadTrans t) 393 | => WDLog -> WebDriverTT t eff () 394 | logNotice = WDT . Http.logNotice 395 | 396 | -- | Write a comment to the log. 397 | comment 398 | :: (Monad eff, Monad (t eff), MonadTrans t) 399 | => Text -> WebDriverTT t eff () 400 | comment = WDT . Http.comment 401 | 402 | -- | Suspend the current session. Handy when waiting for pages to load. 403 | wait 404 | :: (Monad eff, Monad (t eff), MonadTrans t) 405 | => Int -- ^ Wait time in milliseconds 406 | -> WebDriverTT t eff () 407 | wait = WDT . Http.wait 408 | 409 | throwError 410 | :: (Monad eff, Monad (t eff), MonadTrans t) 411 | => WDError -> WebDriverTT t eff a 412 | throwError = WDT . Http.throwError 413 | 414 | throwJsonError 415 | :: (Monad eff, Monad (t eff), MonadTrans t) 416 | => Http.JsonError -> WebDriverTT t eff a 417 | throwJsonError = WDT . Http.throwJsonError 418 | 419 | throwHttpException 420 | :: (Monad eff, Monad (t eff), MonadTrans t) 421 | => N.HttpException -> WebDriverTT t eff a 422 | throwHttpException = WDT . Http.throwHttpException 423 | 424 | throwIOException 425 | :: (Monad eff, Monad (t eff), MonadTrans t) 426 | => IOException -> WebDriverTT t eff a 427 | throwIOException = WDT . Http.throwIOException 428 | 429 | -- | Explicitly handle any of the error types thrown in `WebDriverTT` 430 | catchAnyError 431 | :: (Monad eff, Monad (t eff), MonadTrans t) 432 | => WebDriverTT t eff a 433 | -> (WDError -> WebDriverTT t eff a) 434 | -> (N.HttpException -> WebDriverTT t eff a) 435 | -> (IOException -> WebDriverTT t eff a) 436 | -> (Http.JsonError -> WebDriverTT t eff a) 437 | -> WebDriverTT t eff a 438 | catchAnyError x hE hH hI hJ = WDT $ Http.catchAnyError (unWDT x) 439 | (unWDT . hE) (unWDT . hH) (unWDT . hI) (unWDT . hJ) 440 | 441 | -- | Rethrows other error types 442 | catchError 443 | :: (Monad eff, Monad (t eff), MonadTrans t) 444 | => WebDriverTT t eff a 445 | -> (WDError -> WebDriverTT t eff a) 446 | -> WebDriverTT t eff a 447 | catchError x h = WDT $ Http.catchError (unWDT x) (unWDT . h) 448 | 449 | -- | Rethrows other error types 450 | catchJsonError 451 | :: (Monad eff, Monad (t eff), MonadTrans t) 452 | => WebDriverTT t eff a 453 | -> (Http.JsonError -> WebDriverTT t eff a) 454 | -> WebDriverTT t eff a 455 | catchJsonError x h = WDT $ Http.catchJsonError (unWDT x) (unWDT . h) 456 | 457 | -- | Rethrows other error types 458 | catchHttpException 459 | :: (Monad eff, Monad (t eff), MonadTrans t) 460 | => WebDriverTT t eff a 461 | -> (N.HttpException -> WebDriverTT t eff a) 462 | -> WebDriverTT t eff a 463 | catchHttpException x h = WDT $ Http.catchHttpException (unWDT x) (unWDT . h) 464 | 465 | -- | Rethrows other error types 466 | catchIOException 467 | :: (Monad eff, Monad (t eff), MonadTrans t) 468 | => WebDriverTT t eff a 469 | -> (IOException -> WebDriverTT t eff a) 470 | -> WebDriverTT t eff a 471 | catchIOException x h = WDT $ Http.catchIOException (unWDT x) (unWDT . h) 472 | 473 | -- | May throw a `JsonError`. 474 | parseJson 475 | :: (Monad eff, Monad (t eff), MonadTrans t) 476 | => ByteString -> WebDriverTT t eff Value 477 | parseJson = WDT . Http.parseJson 478 | 479 | -- | May throw a `JsonError`. 480 | lookupKeyJson 481 | :: (Monad eff, Monad (t eff), MonadTrans t) 482 | => Text -> Value -> WebDriverTT t eff Value 483 | lookupKeyJson k = WDT . Http.lookupKeyJson k 484 | 485 | -- | May throw a `JsonError`. 486 | constructFromJson 487 | :: (Monad eff, Monad (t eff), MonadTrans t, FromJSON a) 488 | => Value -> WebDriverTT t eff a 489 | constructFromJson = WDT . Http.constructFromJson 490 | 491 | -- | Capures `HttpException`s. 492 | httpGet 493 | :: (Monad eff, Monad (t eff), MonadTrans t) 494 | => Http.Url -> WebDriverTT t eff Http.HttpResponse 495 | httpGet = WDT . Http.httpGet 496 | 497 | -- | Does not write request or response info to the log, except to note that a request occurred. Capures `HttpException`s. 498 | httpSilentGet 499 | :: (Monad eff, Monad (t eff), MonadTrans t) 500 | => Http.Url -> WebDriverTT t eff Http.HttpResponse 501 | httpSilentGet = WDT . Http.httpSilentGet 502 | 503 | -- | Capures `HttpException`s. 504 | httpPost 505 | :: (Monad eff, Monad (t eff), MonadTrans t) 506 | => Http.Url -> ByteString -> WebDriverTT t eff Http.HttpResponse 507 | httpPost url = WDT . Http.httpPost url 508 | 509 | -- | Does not write request or response info to the log, except to note that a request occurred. Capures `HttpException`s. 510 | httpSilentPost 511 | :: (Monad eff, Monad (t eff), MonadTrans t) 512 | => Http.Url -> ByteString -> WebDriverTT t eff Http.HttpResponse 513 | httpSilentPost url = WDT . Http.httpSilentPost url 514 | 515 | -- | Capures `HttpException`s. 516 | httpDelete 517 | :: (Monad eff, Monad (t eff), MonadTrans t) 518 | => Http.Url -> WebDriverTT t eff Http.HttpResponse 519 | httpDelete = WDT . Http.httpDelete 520 | 521 | -- | Does not write request or response info to the log, except to note that a request occurred. Capures `HttpException`s. 522 | httpSilentDelete 523 | :: (Monad eff, Monad (t eff), MonadTrans t) 524 | => Http.Url -> WebDriverTT t eff Http.HttpResponse 525 | httpSilentDelete = WDT . Http.httpSilentDelete 526 | 527 | -- | Capures `IOException`s. 528 | hPutStrLn 529 | :: (Monad eff, Monad (t eff), MonadTrans t) 530 | => Handle -> Text -> WebDriverTT t eff () 531 | hPutStrLn h = WDT . Http.hPutStrLn h 532 | 533 | -- | Capures `IOException`s. 534 | hPutStrLnBlocking 535 | :: (Monad eff, Monad (t eff), MonadTrans t) 536 | => MVar () -> Handle -> Text -> WebDriverTT t eff () 537 | hPutStrLnBlocking lock h = WDT . Http.hPutStrLnBlocking lock h 538 | 539 | promptWDAct 540 | :: (Monad eff, Monad (t eff), MonadTrans t) 541 | => WDAct a -> WebDriverTT t eff a 542 | promptWDAct = WDT . Http.prompt . Http.P 543 | 544 | 545 | 546 | instance 547 | (Monad eff, Monad (t eff), MonadTrans t) 548 | => Assert (WebDriverTT t eff) where 549 | assert = logNotice . LogAssertion 550 | 551 | 552 | 553 | 554 | 555 | -- | Filter the assertions from a WebDriver log. 556 | getAssertions :: [WDLog] -> [Assertion] 557 | getAssertions xs = get xs 558 | where 559 | get [] = [] 560 | get (w:ws) = case w of 561 | LogAssertion a -> a : get ws 562 | _ -> get ws 563 | 564 | 565 | 566 | -- | Errors specific to WebDriver sessions. 567 | data WDError 568 | = NoSession 569 | 570 | -- | See 571 | | ResponseError ResponseErrorCode Text Text (Maybe Value) Status 572 | 573 | | UnableToConnect 574 | | RemoteEndTimeout 575 | | UnhandledHttpException N.HttpException 576 | | ImageDecodeError Text 577 | | UnexpectedValue Text 578 | | UnexpectedResult Outcome Text 579 | | BreakpointHaltError 580 | deriving Show 581 | 582 | -- | Read-only environment variables specific to WebDriver. 583 | data WDEnv = WDEnv 584 | { -- | Hostname of the remote WebDriver server 585 | _remoteHostname :: Text 586 | 587 | -- | Port of the remote WebDriver server 588 | , _remotePort :: Int 589 | 590 | -- | Extra path for the remote WebDriver server 591 | , _remotePath :: Text 592 | 593 | -- | Path where secret data is stored 594 | , _dataPath :: FilePath 595 | 596 | -- | Flag for the format of HTTP responses from the remote end. Needed because not all remote ends are spec-compliant. 597 | , _responseFormat :: ResponseFormat 598 | 599 | -- | Version of the WebDriver specification. 600 | , _apiVersion :: ApiVersion 601 | 602 | , _stdin :: Handle 603 | , _stdout :: Handle 604 | } 605 | 606 | -- | Version of the WebDriver specification. 607 | data ApiVersion 608 | = CR_2018_03_04 -- ^ Candidate Recommendation, March 4, 2018 609 | deriving (Eq, Show) 610 | 611 | -- | Format flag for HTTP responses from the remote end. Chromedriver, for instance, is not spec-compliant. :) 612 | data ResponseFormat 613 | = SpecFormat -- ^ Responses as described in the spec. 614 | | ChromeFormat -- ^ Responses as emitted by chromedriver. 615 | deriving (Eq, Show) 616 | 617 | data BreakpointSetting 618 | = BreakpointsOn 619 | | BreakpointsOff 620 | deriving (Eq, Show) 621 | 622 | -- | Includes a @Maybe Text@ representing the current session ID, if one has been opened. 623 | data WDState = WDState 624 | { _sessionId :: Maybe Text 625 | , _breakpoints :: BreakpointSetting 626 | } deriving Show 627 | 628 | breakpointsOn 629 | :: (Monad eff, Monad (t eff), MonadTrans t) 630 | => WebDriverTT t eff () 631 | breakpointsOn = modifyState $ \st -> st 632 | { Http._userState = (Http._userState st) 633 | { _breakpoints = BreakpointsOn 634 | } 635 | } 636 | 637 | breakpointsOff 638 | :: (Monad eff, Monad (t eff), MonadTrans t) 639 | => WebDriverTT t eff () 640 | breakpointsOff = modifyState $ \st -> st 641 | { Http._userState = (Http._userState st) 642 | { _breakpoints = BreakpointsOff 643 | } 644 | } 645 | 646 | -- | WebDriver specific log entries. 647 | data WDLog 648 | = LogAssertion Assertion 649 | | LogSession SessionVerb 650 | | LogUnexpectedResult Outcome Text 651 | | LogBreakpoint Text 652 | deriving Show 653 | 654 | -- | Pretty printer for log entries. 655 | printWDLog :: Bool -> WDLog -> Text 656 | printWDLog _ w = T.pack $ show w 657 | 658 | -- | Type representing an abstract outcome. Do with it what you will. 659 | data Outcome = IsSuccess | IsFailure 660 | deriving (Eq, Show) 661 | 662 | -- | Representation of the actions we can perform on a `Session` (in the @wreq@ sense). 663 | data SessionVerb 664 | = Close | Open 665 | deriving (Eq, Show) 666 | 667 | -- | WebDriver specific effects 668 | data WDAct a where 669 | ReadFilePath :: FilePath -> WDAct (Either IOException ByteString) 670 | WriteFilePath :: FilePath -> ByteString -> WDAct (Either IOException ()) 671 | FileExists :: FilePath -> WDAct (Either IOException Bool) 672 | 673 | HGetLine :: Handle -> WDAct (Either IOException Text) 674 | HGetLineNoEcho :: Handle -> WDAct (Either IOException Text) 675 | 676 | 677 | 678 | -- | For validating responses. Throws an `UnexpectedValue` error if the two arguments are not equal according to their `Eq` instance. 679 | expect 680 | :: (Monad eff, Monad (t eff), MonadTrans t, Eq a, Show a) 681 | => a 682 | -> a 683 | -> WebDriverTT t eff a 684 | expect x y = if x == y 685 | then return y 686 | else throwError $ UnexpectedValue $ 687 | "expected " <> T.pack (show x) <> " but got " <> T.pack (show y) 688 | 689 | -- | For validating responses. Throws an `UnexpectedValue` error if the `a` argument does not satisfy the predicate. 690 | expectIs 691 | :: (Monad eff, Monad (t eff), MonadTrans t, Show a) 692 | => (a -> Bool) 693 | -> Text -- ^ Human readable error label 694 | -> a 695 | -> WebDriverTT t eff a 696 | expectIs p label x = if p x 697 | then return x 698 | else throwError $ UnexpectedValue $ 699 | "expected " <> label <> " but got " <> T.pack (show x) 700 | 701 | -- | Promote semantic HTTP exceptions to typed errors. 702 | promoteHttpResponseError :: N.HttpException -> Maybe WDError 703 | promoteHttpResponseError e = case e of 704 | N.HttpExceptionRequest _ (N.StatusCodeException s r) -> do 705 | err <- r ^? key "value" . key "error" . _Value 706 | code <- case fromJSON err of 707 | Success m -> return m 708 | _ -> Nothing 709 | msg <- r ^? key "value" . key "message" . _String 710 | str <- r ^? key "value" . key "stacktrace" . _String 711 | let obj = r ^? key "value" . key "data" . _Value 712 | status <- s ^? responseStatus 713 | return $ ResponseError code msg str obj status 714 | 715 | N.HttpExceptionRequest _ (N.ConnectionFailure _) -> Just UnableToConnect 716 | 717 | N.HttpExceptionRequest _ N.ConnectionTimeout -> Just RemoteEndTimeout 718 | 719 | _ -> Just $ UnhandledHttpException e 720 | 721 | -- | For pretty printing. 722 | printWDError :: Bool -> WDError -> Text 723 | printWDError _ e = case e of 724 | NoSession -> "No session in progress" 725 | ResponseError _ msg trace obj status -> 726 | let 727 | code = status ^. statusCode 728 | smsg = status ^. statusMessage 729 | in 730 | (("Response: " <> T.pack (show code) <> " " <> T.decodeUtf8 smsg <> "\n") <>) $ 731 | T.decodeUtf8 $ toStrict $ encodePretty $ object 732 | [ "error" .= toJSON code 733 | , "message" .= toJSON msg 734 | , "stacktrace" .= toJSON trace 735 | , "data" .= (toJSON <$> obj) 736 | ] 737 | UnableToConnect -> "Unable to connect to WebDriver server" 738 | RemoteEndTimeout -> "Remote End Timeout" 739 | UnhandledHttpException ex -> "Unhandled HTTP Exception: " <> T.pack (show ex) 740 | ImageDecodeError msg -> "Image decode: " <> msg 741 | UnexpectedValue msg -> "Unexpected value: " <> msg 742 | UnexpectedResult r msg -> case r of 743 | IsSuccess -> "Unexpected success: " <> msg 744 | IsFailure -> "Unexpected failure: " <> msg 745 | BreakpointHaltError -> "Breakpoint Halt" 746 | 747 | putStrLn 748 | :: (Monad eff, Monad (t eff), MonadTrans t) 749 | => Text -> WebDriverTT t eff () 750 | putStrLn str = do 751 | outH <- fromEnv (_stdout . Http._env) 752 | hPutStrLn outH str 753 | 754 | getStrLn 755 | :: (Monad eff, Monad (t eff), MonadTrans t) 756 | => WebDriverTT t eff Text 757 | getStrLn = do 758 | inH <- fromEnv (_stdin . Http._env) 759 | result <- promptWDAct $ HGetLine inH 760 | case result of 761 | Right string -> return string 762 | Left e -> throwIOException e 763 | 764 | -- | Prompt for input on `stdin`. 765 | promptForString 766 | :: (Monad eff, Monad (t eff), MonadTrans t) 767 | => Text -- ^ Prompt text 768 | -> WebDriverTT t eff Text 769 | promptForString prompt = 770 | putStrLn prompt >> getStrLn 771 | 772 | -- | Prompt for input on `stdin`, but do not echo the typed characters back to the terminal -- handy for getting suuper secret info. 773 | promptForSecret 774 | :: (Monad eff, Monad (t eff), MonadTrans t) 775 | => Text -- ^ Prompt text 776 | -> WebDriverTT t eff Text 777 | promptForSecret prompt = do 778 | outH <- fromEnv (_stdout . Http._env) 779 | inH <- fromEnv (_stdin . Http._env) 780 | hPutStrLn outH prompt 781 | result <- promptWDAct $ HGetLineNoEcho inH 782 | case result of 783 | Right string -> return string 784 | Left e -> throwIOException e 785 | 786 | -- | Captures `IOException`s 787 | readFilePath 788 | :: (Monad eff, Monad (t eff), MonadTrans t) 789 | => FilePath 790 | -> WebDriverTT t eff ByteString 791 | readFilePath path = do 792 | result <- promptWDAct $ ReadFilePath path 793 | case result of 794 | Right bytes -> return bytes 795 | Left e -> throwIOException e 796 | 797 | -- | Captures `IOException`s 798 | writeFilePath 799 | :: (Monad eff, Monad (t eff), MonadTrans t) 800 | => FilePath 801 | -> ByteString 802 | -> WebDriverTT t eff () 803 | writeFilePath path bytes = do 804 | result <- promptWDAct $ WriteFilePath path bytes 805 | case result of 806 | Right () -> return () 807 | Left e -> throwIOException e 808 | 809 | -- | Captures `IOException`s 810 | fileExists 811 | :: (Monad eff, Monad (t eff), MonadTrans t) 812 | => FilePath 813 | -> WebDriverTT t eff Bool 814 | fileExists path = do 815 | result <- promptWDAct $ FileExists path 816 | case result of 817 | Right p -> return p 818 | Left e -> throwIOException e 819 | 820 | 821 | 822 | data BreakpointAction 823 | = BreakpointContinue 824 | | BreakpointHalt 825 | | BreakpointDump -- ^ Show the current state and environment 826 | | BreakpointSilence -- ^ Turn breakpoints off and continue 827 | | BreakpointAct -- ^ Client-supplied action 828 | deriving (Eq, Show) 829 | 830 | parseBreakpointAction :: Text -> Maybe BreakpointAction 831 | parseBreakpointAction str = case str of 832 | "c" -> Just BreakpointContinue 833 | "h" -> Just BreakpointHalt 834 | "d" -> Just BreakpointDump 835 | "s" -> Just BreakpointSilence 836 | "a" -> Just BreakpointAct 837 | _ -> Nothing 838 | 839 | breakpointMessage 840 | :: (Monad eff, Monad (t eff), MonadTrans t) 841 | => Text -> Maybe Text -> WebDriverTT t eff () 842 | breakpointMessage msg custom = do 843 | putStrLn "=== BREAKPOINT ===" 844 | putStrLn msg 845 | putStrLn "c : continue" 846 | putStrLn "h : halt" 847 | putStrLn "d : dump webdriver state" 848 | putStrLn "s : turn breakpoints off and continue" 849 | case custom of 850 | Just act -> putStrLn $ "a : " <> act 851 | Nothing -> return () 852 | putStrLn "==================" 853 | 854 | breakpointWith 855 | :: (Monad eff, Monad (t eff), MonadTrans t) 856 | => Text 857 | -> Maybe (Text, WebDriverTT t eff ()) 858 | -> WebDriverTT t eff () 859 | breakpointWith msg act = do 860 | bp <- fromState (_breakpoints . Http._userState) 861 | case bp of 862 | BreakpointsOff -> return () 863 | BreakpointsOn -> do 864 | logNotice $ LogBreakpoint msg 865 | let 866 | (actionDescription, action) = case act of 867 | Nothing -> (Nothing, return ()) 868 | Just (title, action') -> (Just title, action') 869 | breakpointMessage msg actionDescription 870 | command <- getStrLn 871 | case parseBreakpointAction command of 872 | Just BreakpointContinue -> return () 873 | Just BreakpointHalt -> throwError BreakpointHaltError 874 | Just BreakpointDump -> do 875 | putStrLn "=== DUMP =========" 876 | fromState dumpState >>= putStrLn 877 | fromEnv dumpEnv >>= putStrLn 878 | putStrLn "==================" 879 | breakpointWith msg act 880 | Just BreakpointSilence -> breakpointsOff 881 | Just BreakpointAct -> action 882 | Nothing -> do 883 | putStrLn $ "Unrecognized breakpoint option '" <> command <> "'" 884 | breakpointWith msg act 885 | 886 | breakpoint 887 | :: (Monad eff, Monad (t eff), MonadTrans t) 888 | => Text 889 | -> WebDriverTT t eff () 890 | breakpoint msg = breakpointWith msg Nothing 891 | 892 | dumpState :: Http.S WDState -> Text 893 | dumpState Http.S{..} = T.intercalate "\n" 894 | [ "Session ID: " <> T.pack (show $ _sessionId _userState) 895 | , T.pack $ show (_breakpoints _userState) 896 | ] 897 | 898 | dumpEnv :: Http.R WDError WDLog WDEnv -> Text 899 | dumpEnv Http.R{..} = T.intercalate "\n" 900 | [ "Remote Host: " <> (_remoteHostname _env) 901 | , "Remote Port: " <> T.pack (show $ _remotePort _env) 902 | , "Remote Path: " <> (_remotePath _env) 903 | , "Data Path: " <> T.pack (_dataPath _env) 904 | , "Response Format: " <> T.pack (show $ _responseFormat _env) 905 | , "API Version: " <> T.pack (show $ _apiVersion _env) 906 | ] 907 | 908 | 909 | 910 | -- | Standard `IO` evaluator for `WDAct`. 911 | evalWDAct :: WDAct a -> IO a 912 | evalWDAct act = case act of 913 | ReadFilePath path -> try $ readFile path 914 | WriteFilePath path bytes -> try $ writeFile path bytes 915 | FileExists path -> try $ doesFileExist path 916 | 917 | HGetLine handle -> try $ do 918 | T.hGetLine handle 919 | 920 | HGetLineNoEcho handle -> try $ do 921 | echo <- hGetEcho handle 922 | hSetEcho handle False 923 | secret <- T.hGetLine handle 924 | hSetEcho handle echo 925 | return secret 926 | 927 | 928 | 929 | -- | Standard `Mock.MockIO` evaluator for `WDAct`. 930 | evalWDActMockIO :: WDAct a -> Mock.MockIO u a 931 | evalWDActMockIO act = case act of 932 | ReadFilePath path -> do 933 | Mock.incrementTimer 1 934 | world <- Mock.getMockWorld 935 | let result = FS.getLines (Left path) $ Mock._files world 936 | case result of 937 | Nothing -> do 938 | return $ Left $ mkIOError doesNotExistErrorType "" Nothing (Just path) 939 | Just lns -> return $ Right $ fromStrict $ T.encodeUtf8 $ T.unlines lns 940 | 941 | WriteFilePath path bytes -> do 942 | Mock.incrementTimer 1 943 | fmap Right $ Mock.modifyMockWorld $ \w -> w 944 | { Mock._files = FS.writeLines (Left path) [T.decodeUtf8 $ toStrict bytes] $ Mock._files w } 945 | 946 | FileExists path -> do 947 | Mock.incrementTimer 1 948 | world <- Mock.getMockWorld 949 | return $ Right $ FS.fileExists (Left path) $ Mock._files world 950 | 951 | HGetLine handle -> do 952 | Mock.incrementTimer 1 953 | world <- Mock.getMockWorld 954 | let dne = mkIOError doesNotExistErrorType "" (Just handle) Nothing 955 | let eof = mkIOError eofErrorType "" (Just handle) Nothing 956 | let result = FS.readLine dne eof (Right handle) $ Mock._files world 957 | case result of 958 | Left err -> return $ Left err 959 | Right (txt, fs) -> do 960 | Mock.modifyMockWorld $ \w -> w { Mock._files = fs } 961 | return $ Right txt 962 | 963 | HGetLineNoEcho handle -> do 964 | Mock.incrementTimer 1 965 | world <- Mock.getMockWorld 966 | let dne = mkIOError doesNotExistErrorType "" (Just handle) Nothing 967 | let eof = mkIOError eofErrorType "" (Just handle) Nothing 968 | let result = FS.readLine dne eof (Right handle) $ Mock._files world 969 | case result of 970 | Left err -> return $ Left err 971 | Right (txt, fs) -> do 972 | Mock.modifyMockWorld $ \w -> w { Mock._files = fs } 973 | return $ Right txt 974 | -------------------------------------------------------------------------------- /src/Web/Api/WebDriver/Types/Keyboard.hs: -------------------------------------------------------------------------------- 1 | {- | 2 | Module : Web.Api.WebDriver.Types.Keyboard 3 | Description : Type representing key presses. 4 | Copyright : 2018, Automattic, Inc. 5 | License : GPL-3 6 | Maintainer : Nathan Bloomfield (nbloomf@gmail.com) 7 | Stability : experimental 8 | Portability : POSIX 9 | -} 10 | 11 | module Web.Api.WebDriver.Types.Keyboard ( 12 | Key(..) 13 | , keyToChar 14 | ) where 15 | 16 | -- | See . 17 | data Key 18 | = UnidentifiedKey 19 | | CancelKey 20 | | HelpKey 21 | | BackspaceKey 22 | | TabKey 23 | | ClearKey 24 | | ReturnKey 25 | | EnterKey 26 | | ShiftKey 27 | | ControlKey 28 | | AltKey 29 | | PauseKey 30 | | EscapeKey 31 | | PageUpKey 32 | | PageDownKey 33 | | EndKey 34 | | HomeKey 35 | | ArrowLeftKey 36 | | ArrowUpKey 37 | | ArrowRightKey 38 | | ArrowDownKey 39 | | InsertKey 40 | | DeleteKey 41 | | F1Key 42 | | F2Key 43 | | F3Key 44 | | F4Key 45 | | F5Key 46 | | F6Key 47 | | F7Key 48 | | F8Key 49 | | F9Key 50 | | F10Key 51 | | F11Key 52 | | F12Key 53 | | MetaKey 54 | | ZenkakuHankakuKey 55 | 56 | -- | See . 57 | keyToChar :: Key -> Char 58 | keyToChar key = case key of 59 | UnidentifiedKey -> '\xe000' 60 | CancelKey -> '\xe001' 61 | HelpKey -> '\xe002' 62 | BackspaceKey -> '\xe003' 63 | TabKey -> '\xe004' 64 | ClearKey -> '\xe005' 65 | ReturnKey -> '\xe006' 66 | EnterKey -> '\xe007' 67 | ShiftKey -> '\xe008' 68 | ControlKey -> '\xe009' 69 | AltKey -> '\xe00a' 70 | PauseKey -> '\xe00b' 71 | EscapeKey -> '\xe00c' 72 | PageUpKey -> '\xe00e' 73 | PageDownKey -> '\xe00f' 74 | EndKey -> '\xe010' 75 | HomeKey -> '\xe011' 76 | ArrowLeftKey -> '\xe012' 77 | ArrowUpKey -> '\xe013' 78 | ArrowRightKey -> '\xe014' 79 | ArrowDownKey -> '\xe015' 80 | InsertKey -> '\xe016' 81 | DeleteKey -> '\xe017' 82 | F1Key -> '\xe031' 83 | F2Key -> '\xe032' 84 | F3Key -> '\xe033' 85 | F4Key -> '\xe034' 86 | F5Key -> '\xe035' 87 | F6Key -> '\xe036' 88 | F7Key -> '\xe037' 89 | F8Key -> '\xe038' 90 | F9Key -> '\xe039' 91 | F10Key -> '\xe03a' 92 | F11Key -> '\xe03b' 93 | F12Key -> '\xe03c' 94 | MetaKey -> '\xe03d' 95 | ZenkakuHankakuKey -> '\xe040' 96 | -------------------------------------------------------------------------------- /src/Web/Api/WebDriver/Uri.hs: -------------------------------------------------------------------------------- 1 | {- | 2 | Module : Web.Api.WebDriver.Uri 3 | Description : Types and functions for validating parts of a URI. 4 | Copyright : 2018, Automattic, Inc. 5 | License : GPL-3 6 | Maintainer : Nathan Bloomfield (nbloomf@gmail.com) 7 | Stability : experimental 8 | Portability : POSIX 9 | -} 10 | 11 | module Web.Api.WebDriver.Uri ( 12 | Host() 13 | , mkHost 14 | , Port() 15 | , mkPort 16 | ) where 17 | 18 | import Data.Text (Text) 19 | import qualified Data.Text as T 20 | import Test.QuickCheck 21 | ( Arbitrary(..), oneof, vectorOf, Positive(..) ) 22 | 23 | 24 | -- | The host part of a URI. See . 25 | newtype Host = Host 26 | { unHost :: Text 27 | } deriving Eq 28 | 29 | -- | Constructor for hosts that checks for invalid characters. 30 | mkHost :: Text -> Maybe Host 31 | mkHost str = 32 | if T.all (`elem` hostAllowedChars) str 33 | then Just (Host str) 34 | else Nothing 35 | 36 | instance Show Host where 37 | show = T.unpack . unHost 38 | 39 | instance Arbitrary Host where 40 | arbitrary = do 41 | Positive k <- arbitrary 42 | str <- vectorOf k $ oneof $ map return hostAllowedChars 43 | case mkHost $ T.pack str of 44 | Just h -> return h 45 | Nothing -> error "In Arbitrary instance for Host: bad characters." 46 | 47 | hostAllowedChars :: [Char] 48 | hostAllowedChars = concat 49 | [ ['a'..'z'], ['A'..'Z'], ['0'..'9'], ['-','_','.','~','%'] ] 50 | 51 | 52 | 53 | -- | The port part of a URI. 54 | newtype Port = Port { unPort :: Text } 55 | deriving Eq 56 | 57 | -- | Constructor for ports. 58 | mkPort :: Text -> Maybe Port 59 | mkPort str = 60 | if T.all (`elem` ['0'..'9']) str 61 | then Just (Port str) 62 | else Nothing 63 | 64 | instance Show Port where 65 | show = T.unpack . unPort 66 | 67 | instance Arbitrary Port where 68 | arbitrary = do 69 | Positive k <- arbitrary 70 | str <- vectorOf k $ oneof $ map return ['0'..'9'] 71 | case mkPort $ T.pack str of 72 | Just p -> return p 73 | Nothing -> error "In Arbitrary instance for Port: bad characters." 74 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-16.0 2 | 3 | packages: 4 | - . 5 | 6 | extra-deps: 7 | - script-monad-0.0.4 8 | -------------------------------------------------------------------------------- /test/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import System.Environment (setEnv, getArgs, withArgs) 4 | import System.Directory (getCurrentDirectory) 5 | import Control.Concurrent.MVar (newMVar) 6 | 7 | import Test.Tasty 8 | import Test.Tasty.WebDriver 9 | 10 | import Test.Tasty.WebDriver.Config.Test 11 | import Web.Api.WebDriver.Assert.Test 12 | import Web.Api.WebDriver.Monad.Test 13 | import Web.Api.WebDriver.Types.Test 14 | 15 | 16 | main :: IO () 17 | main = do 18 | 19 | putStrLn "" 20 | putStrLn "\x1b[1;34m ___ __ __ __ ___ __ __ __ ___ ___ __ ___ \x1b[0;39;49m" 21 | putStrLn "\x1b[1;34m| | |__ |__) | \\ |__) | \\ / |__ |__) __ | | '__\\ / ` __ | |__ /__` | \x1b[0;39;49m" 22 | putStrLn "\x1b[1;34m|/\\| |___ |__) |__/ | \\ | \\/ |___ | \\ |/\\| .__/ \\__, | |___ .__/ | \x1b[0;39;49m" 23 | putStrLn "\x1b[1;34m \x1b[0;39;49m" 24 | 25 | setEnv "TASTY_NUM_THREADS" "2" -- needed for live tests 26 | testPagePath <- fmap (\path -> path ++ "/test/page") getCurrentDirectory 27 | lock <- newMVar () 28 | 29 | args <- getArgs 30 | withArgs (["--wd-remote-ends","geckodriver https://localhost:4444 https://localhost:4445 chromedriver https://localhost:9515 https://localhost:9516"] ++ args) $ 31 | defaultWebDriverMain $ 32 | (localOption $ NumRetries 1) $ 33 | testGroup "All Tests" 34 | [ Test.Tasty.WebDriver.Config.Test.tests 35 | , Web.Api.WebDriver.Assert.Test.tests lock 36 | , Web.Api.WebDriver.Types.Test.tests 37 | , Web.Api.WebDriver.Monad.Test.tests ("file://" ++ testPagePath) 38 | ] 39 | -------------------------------------------------------------------------------- /test/Test/Tasty/WebDriver/Config/Test.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Test.Tasty.WebDriver.Config.Test ( 3 | tests 4 | ) where 5 | 6 | import Data.Text (Text) 7 | import qualified Data.Text as Text 8 | 9 | import qualified Test.Tasty as TT 10 | import qualified Test.Tasty.HUnit as HU 11 | import qualified Data.Map.Strict as MS 12 | 13 | import Test.Tasty.WebDriver.Config 14 | 15 | tests :: TT.TestTree 16 | tests = TT.testGroup "Test.Tasty.WebDriver.Config" 17 | [ check_parseRemoteEnd 18 | , check_parseRemoteEndOption 19 | , check_parseRemoteEndConfig 20 | ] 21 | 22 | checkParser :: (Eq a, Show a) => (Text -> a) -> (String, Text, a) -> TT.TestTree 23 | checkParser f (title, str, x) = 24 | let y = f str in 25 | HU.testCase title $ 26 | if y == x 27 | then return () 28 | else do 29 | HU.assertFailure $ "Error parsing '" ++ Text.unpack str ++ "': expected " 30 | ++ show x ++ " but got " ++ show y 31 | 32 | check_parseRemoteEnd :: TT.TestTree 33 | check_parseRemoteEnd = TT.testGroup "parseRemoteEnd" $ 34 | map (checkParser parseRemoteEnd) _parseRemoteEnd_cases 35 | 36 | _parseRemoteEnd_cases :: [(String, Text, Either Text RemoteEnd)] 37 | _parseRemoteEnd_cases = 38 | [ ( "'localhost'" 39 | , "localhost" 40 | , Left "Could not parse remote end URI 'localhost'." 41 | ) 42 | 43 | , ( "'localhost:4444'" 44 | , "localhost:4444" 45 | , Left "Error parsing authority for URI 'localhost:4444'." 46 | ) 47 | 48 | , ( "'http://localhost:4444'" 49 | , "http://localhost:4444" 50 | , Right $ RemoteEnd "localhost" 4444 "" 51 | ) 52 | 53 | , ( "'https://localhost:4444'" 54 | , "https://localhost:4444" 55 | , Right $ RemoteEnd "localhost" 4444 "" 56 | ) 57 | 58 | , ( "'http://localhost'" 59 | , "http://localhost" 60 | , Right $ RemoteEnd "localhost" 4444 "" 61 | ) 62 | 63 | , ( "'https://localhost'" 64 | , "https://localhost" 65 | , Right $ RemoteEnd "localhost" 4444 "" 66 | ) 67 | ] 68 | 69 | check_parseRemoteEndOption :: TT.TestTree 70 | check_parseRemoteEndOption = TT.testGroup "parseRemoteEndOption" $ 71 | map (checkParser parseRemoteEndOption) _parseRemoteEndOption_cases 72 | 73 | _parseRemoteEndOption_cases :: [(String, Text, Either Text RemoteEndPool)] 74 | _parseRemoteEndOption_cases = 75 | [ ( "geckodriver+1" 76 | , "geckodriver https://localhost:4444" 77 | , Right $ RemoteEndPool $ 78 | MS.fromList [(Geckodriver, [RemoteEnd "localhost" 4444 ""])] 79 | ) 80 | 81 | , ( "geckodriver+1 (repeated)" 82 | , "geckodriver https://localhost:4444 https://localhost:4444" 83 | , Right $ RemoteEndPool $ 84 | MS.fromList [(Geckodriver, [RemoteEnd "localhost" 4444 ""])] 85 | ) 86 | 87 | , ( "geckodriver+2" 88 | , "geckodriver https://localhost:4444 https://localhost:4445" 89 | , Right $ RemoteEndPool $ 90 | MS.fromList [(Geckodriver, [RemoteEnd "localhost" 4444 "", RemoteEnd "localhost" 4445 ""])] 91 | ) 92 | 93 | , ( "chromedriver+1" 94 | , "chromedriver https://localhost:4444" 95 | , Right $ RemoteEndPool $ 96 | MS.fromList [(Chromedriver, [RemoteEnd "localhost" 4444 ""])] 97 | ) 98 | 99 | , ( "chromedriver+1 (repeated)" 100 | , "chromedriver https://localhost:4444 https://localhost:4444" 101 | , Right $ RemoteEndPool $ 102 | MS.fromList [(Chromedriver, [RemoteEnd "localhost" 4444 ""])] 103 | ) 104 | 105 | , ( "chromedriver+2" 106 | , "chromedriver https://localhost:4444 https://localhost:4445" 107 | , Right $ RemoteEndPool $ 108 | MS.fromList [(Chromedriver, [RemoteEnd "localhost" 4444 "", RemoteEnd "localhost" 4445 ""])] 109 | ) 110 | 111 | , ( "geckodriver+1, chromedriver+1" 112 | , "geckodriver https://localhost:4444 chromedriver https://localhost:9515" 113 | , Right $ RemoteEndPool $ 114 | MS.fromList 115 | [ (Geckodriver, [RemoteEnd "localhost" 4444 ""]) 116 | , (Chromedriver, [RemoteEnd "localhost" 9515 ""]) 117 | ] 118 | ) 119 | ] 120 | 121 | check_parseRemoteEndConfig :: TT.TestTree 122 | check_parseRemoteEndConfig = TT.testGroup "parseRemoteEndConfig" $ 123 | map (checkParser parseRemoteEndConfig) _parseRemoteEndConfig_cases 124 | 125 | _parseRemoteEndConfig_cases :: [(String, Text, Either Text RemoteEndPool)] 126 | _parseRemoteEndConfig_cases = 127 | [ ( "geckodriver+1" 128 | , "geckodriver\n- https://localhost:4444\n" 129 | , Right $ RemoteEndPool $ 130 | MS.fromList [(Geckodriver, [RemoteEnd "localhost" 4444 ""])] 131 | ) 132 | 133 | , ( "geckodriver+1 (repeated)" 134 | , "geckodriver\n- https://localhost:4444\n- https://localhost:4444\n" 135 | , Right $ RemoteEndPool $ 136 | MS.fromList [(Geckodriver, [RemoteEnd "localhost" 4444 ""])] 137 | ) 138 | 139 | , ( "geckodriver+2" 140 | , "geckodriver\n- https://localhost:4444\n- https://localhost:4445\n" 141 | , Right $ RemoteEndPool $ 142 | MS.fromList [(Geckodriver, [RemoteEnd "localhost" 4444 "", RemoteEnd "localhost" 4445 ""])] 143 | ) 144 | 145 | , ( "chromedriver+1" 146 | , "chromedriver\n- https://localhost:4444\n" 147 | , Right $ RemoteEndPool $ 148 | MS.fromList [(Chromedriver, [RemoteEnd "localhost" 4444 ""])] 149 | ) 150 | 151 | , ( "chromedriver+1 (repeated)" 152 | , "chromedriver\n- https://localhost:4444\n- https://localhost:4444\n" 153 | , Right $ RemoteEndPool $ 154 | MS.fromList [(Chromedriver, [RemoteEnd "localhost" 4444 ""])] 155 | ) 156 | 157 | , ( "chromedriver+2" 158 | , "chromedriver\n- https://localhost:4444\n- https://localhost:4445\n" 159 | , Right $ RemoteEndPool $ 160 | MS.fromList [(Chromedriver, [RemoteEnd "localhost" 4444 "", RemoteEnd "localhost" 4445 ""])] 161 | ) 162 | 163 | , ( "geckodriver+1, chromedriver+1" 164 | , "geckodriver\n- https://localhost:4444\nchromedriver\n- https://localhost:9515\n" 165 | , Right $ RemoteEndPool $ 166 | MS.fromList 167 | [ (Geckodriver, [RemoteEnd "localhost" 4444 ""]) 168 | , (Chromedriver, [RemoteEnd "localhost" 9515 ""]) 169 | ] 170 | ) 171 | ] 172 | -------------------------------------------------------------------------------- /test/Web/Api/WebDriver/Assert/Test.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Rank2Types, OverloadedStrings #-} 2 | module Web.Api.WebDriver.Assert.Test ( 3 | tests 4 | ) where 5 | 6 | import System.IO 7 | import Data.String 8 | 9 | import qualified Test.Tasty as TT (TestTree(), testGroup) 10 | import qualified Test.Tasty.QuickCheck as QC (testProperty) 11 | import qualified Test.Tasty.HUnit as HU 12 | import Test.QuickCheck (Arbitrary(..)) 13 | 14 | import Data.Text (Text) 15 | import qualified Data.Text as T 16 | 17 | import Control.Concurrent (MVar) 18 | import qualified Network.Wreq as Wreq 19 | import qualified Data.Map as MS 20 | 21 | import Data.MockIO 22 | import Control.Monad.Script.Http 23 | import Web.Api.WebDriver.Monad.Test.Server 24 | 25 | import Web.Api.WebDriver 26 | import Web.Api.WebDriver.Monad.Test.Server 27 | 28 | 29 | 30 | tests :: MVar () -> TT.TestTree 31 | tests lock = TT.testGroup "Web.Api.WebDriver.Assert" 32 | [ TT.testGroup "Mock" 33 | [ assertionTestCases (mockConfig lock) condMockIO 34 | ] 35 | , TT.testGroup "Real" 36 | [ assertionTestCases (realConfig lock) condIO 37 | ] 38 | ] 39 | 40 | instance Arbitrary Text where 41 | arbitrary = T.pack <$> arbitrary 42 | 43 | 44 | 45 | condIO 46 | :: IO (Either (E WDError) t, S WDState, W WDError WDLog) 47 | -> IO AssertionSummary 48 | condIO x = do 49 | (_,_,w) <- x 50 | return $ summarize $ getAssertions $ logEntries w 51 | 52 | realConfig :: MVar () -> WebDriverConfig IO 53 | realConfig lock = WDConfig 54 | { _initialState = defaultWebDriverState 55 | , _environment = defaultWebDriverEnvironment 56 | { _logLock = Just lock 57 | , _logOptions = defaultWebDriverLogOptions 58 | { _logSilent = True 59 | } 60 | } 61 | , _evaluator = evalIO evalWDAct 62 | } 63 | 64 | 65 | 66 | condMockIO 67 | :: MockIO WebDriverServerState (Either (E WDError) t, S WDState, W WDError WDLog) 68 | -> IO AssertionSummary 69 | condMockIO x = do 70 | let ((_,_,w),_) = runMockIO x defaultWebDriverServer 71 | return $ summarize $ getAssertions $ logEntries w 72 | 73 | mockConfig :: MVar () -> WebDriverConfig (MockIO WebDriverServerState) 74 | mockConfig lock = WDConfig 75 | { _evaluator = evalMockIO evalWDActMockIO 76 | , _initialState = defaultWebDriverState 77 | , _environment = defaultWebDriverEnvironment 78 | { _logLock = Just lock 79 | , _logOptions = defaultWebDriverLogOptions 80 | { _logSilent = True 81 | } 82 | } 83 | } 84 | 85 | 86 | 87 | 88 | 89 | assertionTestCases 90 | :: (Monad eff) 91 | => WebDriverConfig eff 92 | -> (eff (Either (E WDError) (), S WDState, W WDError WDLog) -> IO AssertionSummary) 93 | -> TT.TestTree 94 | assertionTestCases config cond = TT.testGroup "Assertions" 95 | [ QC.testProperty "assertSuccess" $ 96 | checkWebDriverT config cond 97 | (== summarize [success "Success!" "yay!"]) $ 98 | do 99 | assertSuccess "yay!" 100 | 101 | , QC.testProperty "assertFailure" $ 102 | checkWebDriverT config cond 103 | (== summarize [failure "Failure :(" "oh no"]) $ 104 | do 105 | assertFailure "oh no" 106 | 107 | , QC.testProperty "assertTrue (success)" $ \msg -> 108 | checkWebDriverT config cond 109 | (== summarize [success "True is True" msg]) $ 110 | do 111 | assertTrue True msg 112 | 113 | , QC.testProperty "assertTrue (failure)" $ \msg -> 114 | checkWebDriverT config cond 115 | (== summarize [failure "False is True" msg]) $ 116 | do 117 | assertTrue False msg 118 | 119 | , QC.testProperty "assertFalse (success)" $ \msg -> 120 | checkWebDriverT config cond 121 | (== summarize [success "False is False" msg]) $ 122 | do 123 | assertFalse False msg 124 | 125 | , QC.testProperty "assertFalse (failure)" $ \msg -> 126 | checkWebDriverT config cond 127 | (== summarize [failure "True is False" msg]) $ 128 | do 129 | assertFalse True msg 130 | 131 | , QC.testProperty "assertEqual (Int, success)" $ \k -> 132 | checkWebDriverT config cond 133 | (== summarize 134 | [success 135 | (AssertionStatement $ 136 | T.pack (show k) <> " is equal to " <> T.pack (show k)) 137 | (AssertionComment $ T.pack $ show k) 138 | ] 139 | ) $ 140 | do 141 | assertEqual 142 | (k :: Int) k 143 | (AssertionComment $ T.pack $ show k) 144 | 145 | , QC.testProperty "assertEqual (Int, failure)" $ \k -> 146 | checkWebDriverT config cond 147 | (== summarize 148 | [failure 149 | (AssertionStatement $ 150 | T.pack (show (k+1)) <> " is equal to " <> T.pack (show k)) 151 | (AssertionComment $ T.pack $ show k) 152 | ] 153 | ) $ 154 | do 155 | assertEqual 156 | (k+1 :: Int) k 157 | (AssertionComment $ T.pack $ show k) 158 | 159 | , QC.testProperty "assertEqual (Text, success)" $ \str -> 160 | checkWebDriverT config cond 161 | (== summarize 162 | [success 163 | (AssertionStatement $ 164 | T.pack (show str) <> " is equal to " <> T.pack (show str)) 165 | (AssertionComment str) 166 | ] 167 | ) $ 168 | do 169 | assertEqual 170 | (str :: Text) str 171 | (AssertionComment str) 172 | 173 | , QC.testProperty "assertEqual (Text, failure)" $ \str -> 174 | checkWebDriverT config cond 175 | (== summarize 176 | [failure 177 | (AssertionStatement $ 178 | T.pack (show $ str <> "?") <> " is equal to " <> T.pack (show str)) 179 | (AssertionComment str) 180 | ] 181 | ) $ 182 | do 183 | assertEqual 184 | (str <> "?" :: Text) str 185 | (AssertionComment str) 186 | 187 | , QC.testProperty "assertNotEqual (Int, success)" $ \k -> 188 | checkWebDriverT config cond 189 | (== summarize 190 | [success 191 | (AssertionStatement $ 192 | T.pack (show (k+1)) <> " is not equal to " <> T.pack (show k)) 193 | (AssertionComment $ T.pack $ show k) 194 | ] 195 | ) $ 196 | do 197 | assertNotEqual 198 | (k+1 :: Int) k 199 | (AssertionComment $ T.pack $ show k) 200 | 201 | , QC.testProperty "assertNotEqual (Int, failure)" $ \k -> 202 | checkWebDriverT config cond 203 | (== summarize 204 | [failure 205 | (AssertionStatement $ 206 | T.pack (show k) <> " is not equal to " <> T.pack (show k)) 207 | (AssertionComment $ T.pack $ show k) 208 | ] 209 | ) $ 210 | do 211 | assertNotEqual 212 | (k :: Int) k 213 | (AssertionComment $ T.pack $ show k) 214 | 215 | , QC.testProperty "assertNotEqual (Text, success)" $ \str -> 216 | checkWebDriverT config cond 217 | (== summarize 218 | [success 219 | (AssertionStatement $ 220 | T.pack (show (str <> "?")) <> " is not equal to " <> T.pack (show str)) 221 | (AssertionComment str) 222 | ] 223 | ) $ 224 | do 225 | assertNotEqual 226 | (str <> "?" :: Text) 227 | (str) 228 | (AssertionComment str) 229 | 230 | , QC.testProperty "assertNotEqual (Text, failure)" $ \str -> 231 | checkWebDriverT config cond 232 | (== summarize 233 | [failure 234 | (AssertionStatement $ 235 | T.pack (show str) <> " is not equal to " <> T.pack (show str)) 236 | (AssertionComment str) 237 | ] 238 | ) $ 239 | do 240 | assertNotEqual 241 | (str :: Text) 242 | (str) 243 | (AssertionComment str) 244 | 245 | , QC.testProperty "assertIsSubstring (success)" $ \str1 str2 -> 246 | checkWebDriverT config cond 247 | (== summarize 248 | [success 249 | (AssertionStatement $ 250 | T.pack (show str1) <> " is a substring of " <> T.pack (show $ str2 <> str1 <> str2)) 251 | (AssertionComment str1) 252 | ] 253 | ) $ 254 | do 255 | assertIsSubstring 256 | (str1 :: Text) 257 | (str2 <> str1 <> str2) 258 | (AssertionComment str1) 259 | 260 | , QC.testProperty "assertIsSubstring (failure)" $ \c str1 str2 -> 261 | let str3 = T.filter (/= c) str2 in 262 | checkWebDriverT config cond 263 | (== summarize 264 | [failure 265 | (AssertionStatement $ 266 | T.pack (show $ T.cons c str1) <> " is a substring of " <> T.pack (show str3)) 267 | (AssertionComment str1) 268 | ] 269 | ) $ 270 | do 271 | assertIsSubstring 272 | (T.cons c str1 :: Text) 273 | (str3) 274 | (AssertionComment str1) 275 | 276 | , QC.testProperty "assertIsNotSubstring (success)" $ \c str1 str2 -> 277 | let str3 = T.filter (/= c) str2 in 278 | checkWebDriverT config cond 279 | (== summarize 280 | [success 281 | (AssertionStatement $ 282 | T.pack (show $ T.cons c str1) <> " is not a substring of " <> T.pack (show str3)) 283 | (AssertionComment str1) 284 | ] 285 | ) $ 286 | do 287 | assertIsNotSubstring 288 | (T.cons c str1 :: Text) 289 | (str3) 290 | (AssertionComment str1) 291 | 292 | , QC.testProperty "assertIsNotSubstring (failure)" $ \str1 str2 -> 293 | checkWebDriverT config cond 294 | (== summarize 295 | [failure 296 | (AssertionStatement $ 297 | T.pack (show str1) <> " is not a substring of " <> T.pack (show $ str2 <> str1 <> str2)) 298 | (AssertionComment str1) 299 | ] 300 | ) $ 301 | do 302 | assertIsNotSubstring 303 | (str1 :: Text) 304 | (str2 <> str1 <> str2) 305 | (AssertionComment str1) 306 | 307 | , QC.testProperty "assertIsNamedSubstring (success)" $ \name str1 str2 -> 308 | checkWebDriverT config cond 309 | (== summarize 310 | [success 311 | (AssertionStatement $ 312 | T.pack (show str1) <> " is a substring of " <> name) 313 | (AssertionComment str1) 314 | ] 315 | ) $ 316 | do 317 | assertIsNamedSubstring 318 | (str1 :: Text) 319 | (str2 <> str1 <> str2, name) 320 | (AssertionComment str1) 321 | 322 | , QC.testProperty "assertIsNamedSubstring (failure)" $ \name c str1 str2 -> 323 | let str3 = T.filter (/= c) str2 in 324 | checkWebDriverT config cond 325 | (== summarize 326 | [failure 327 | (AssertionStatement $ 328 | T.pack (show $ T.cons c str1) <> " is a substring of " <> name) 329 | (AssertionComment str1) 330 | ] 331 | ) $ 332 | do 333 | assertIsNamedSubstring 334 | (T.cons c str1 :: Text) 335 | (str3, name) 336 | (AssertionComment str1) 337 | 338 | , QC.testProperty "assertIsNotNamedSubstring (success)" $ \name c str1 str2 -> 339 | let str3 = T.filter (/= c) str2 in 340 | checkWebDriverT config cond 341 | (== summarize 342 | [success 343 | (AssertionStatement $ 344 | T.pack (show $ T.cons c str1) <> " is not a substring of " <> name) 345 | (AssertionComment str1) 346 | ] 347 | ) $ 348 | do 349 | assertIsNotNamedSubstring 350 | (T.cons c str1 :: Text) 351 | (str3, name) 352 | (AssertionComment str1) 353 | 354 | , QC.testProperty "assertIsNotNamedSubstring (failure)" $ \name str1 str2 -> 355 | checkWebDriverT config cond 356 | (== summarize 357 | [failure 358 | (AssertionStatement $ 359 | T.pack (show str1) <> " is not a substring of " <> name) 360 | (AssertionComment str1) 361 | ] 362 | ) $ 363 | do 364 | assertIsNotNamedSubstring 365 | (str1 :: Text) 366 | (str2 <> str1 <> str2, name) 367 | (AssertionComment str1) 368 | ] 369 | -------------------------------------------------------------------------------- /test/Web/Api/WebDriver/Monad/Test.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns, GADTs #-} 2 | module Web.Api.WebDriver.Monad.Test ( 3 | tests 4 | ) where 5 | 6 | import Test.Tasty (TestTree(), testGroup, localOption) 7 | 8 | import Data.MockIO 9 | 10 | import Web.Api.WebDriver 11 | import Test.Tasty.WebDriver 12 | 13 | import Web.Api.WebDriver.Monad.Test.Server 14 | import Web.Api.WebDriver.Monad.Test.Session.Success 15 | import Web.Api.WebDriver.Monad.Test.Session.UnknownError 16 | import Web.Api.WebDriver.Monad.Test.Session.InvalidElementState 17 | 18 | 19 | tests :: FilePath -> TestTree 20 | tests path = testGroup "Web.Api.WebDriver.Monad" 21 | [ localOption (ApiResponseFormat SpecFormat) 22 | $ localOption (SilentLog) 23 | $ testGroup "Mock Driver" $ endpointTests testCaseMockIO path 24 | 25 | , localOption (Driver Geckodriver) 26 | $ localOption (ApiResponseFormat SpecFormat) 27 | $ localOption (Headless True) 28 | $ localOption (SilentLog) 29 | $ testGroup "Geckodriver" $ endpointTests testCase path 30 | 31 | , localOption (Driver Chromedriver) 32 | $ localOption (ApiResponseFormat SpecFormat) 33 | $ localOption (Headless True) 34 | $ ifTierIs TEST (localOption (BrowserPath $ Just "/usr/bin/google-chrome")) 35 | $ localOption (SilentLog) 36 | $ testGroup "Chromedriver" $ endpointTests testCase path 37 | ] 38 | 39 | 40 | 41 | testCaseMockIO :: String -> WebDriverT (MockIO WebDriverServerState) () -> TestTree 42 | testCaseMockIO name = testCaseM name 43 | (evalMockIO evalWDActMockIO) 44 | (\x -> return $ fst $ runMockIO x defaultWebDriverServer) 45 | 46 | endpointTests 47 | :: (Monad eff) 48 | => (String -> WebDriverT eff () -> TestTree) 49 | -> FilePath 50 | -> [TestTree] 51 | endpointTests buildTestCase path = 52 | [ successfulExit buildTestCase path 53 | , invalidElementStateExit buildTestCase path 54 | , unknownErrorExit buildTestCase path 55 | ] 56 | -------------------------------------------------------------------------------- /test/Web/Api/WebDriver/Monad/Test/Server/Page.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecordWildCards #-} 2 | module Web.Api.WebDriver.Monad.Test.Server.Page ( 3 | HtmlTag(..) 4 | , Attr(..) 5 | , Document(Text, tag, attrs, children, elementId) 6 | , Page(url, contents) 7 | , buildPage 8 | , node 9 | , requestPage 10 | , CssSelector() 11 | , getElementById 12 | , cssMatchDocument 13 | , parseCss 14 | , tagIsClearable 15 | , pageAboutBlank 16 | ) where 17 | 18 | import Text.ParserCombinators.Parsec 19 | import Data.Monoid 20 | import Data.List 21 | 22 | 23 | 24 | 25 | data HtmlTag 26 | = Html 27 | | Head 28 | | Title 29 | | Body 30 | | Div 31 | | P 32 | | Ol 33 | | Ul 34 | | Li 35 | | Form 36 | | Input 37 | | Button 38 | deriving Eq 39 | 40 | instance Show HtmlTag where 41 | show t = case t of 42 | Html -> "html"; Head -> "head"; Title -> "title"; Body -> "body" 43 | Div -> "div"; P -> "p"; Ol -> "ol"; Ul -> "ul"; _ -> error "Show HtmlTag" 44 | 45 | tagIsClearable :: HtmlTag -> Bool 46 | tagIsClearable t = case t of 47 | Input -> True 48 | _ -> False 49 | 50 | data Attr 51 | = Id 52 | | Class 53 | | Name 54 | deriving (Eq, Show) 55 | 56 | data Document 57 | = Text String 58 | | Document 59 | { elementId :: String 60 | , tag :: HtmlTag 61 | , attrs :: [(Attr, Maybe String)] 62 | , children :: [Document] 63 | } 64 | deriving (Eq, Show) 65 | 66 | attrHasValue :: Attr -> String -> Document -> Bool 67 | attrHasValue _ _ (Text _) = False 68 | attrHasValue a v Document{..} = 69 | case lookup a attrs of 70 | Just (Just val) -> v == val 71 | _ -> False 72 | 73 | data Page = Page 74 | { contents :: Document 75 | , url :: String 76 | } deriving Show 77 | 78 | node :: HtmlTag -> [(Attr, Maybe String)] -> [Document] -> Document 79 | node tag attrs children = 80 | let elementId = "" in 81 | Document{..} 82 | 83 | pageAboutBlank :: Page 84 | pageAboutBlank = Page 85 | { contents = Text "" 86 | , url = "about:blank" 87 | } 88 | 89 | 90 | assignIds :: String -> Document -> Document 91 | assignIds _ h@(Text str) = Text str 92 | assignIds base h@Document{..} = h 93 | { elementId = base 94 | , children = zipWith prefix [1..] children 95 | } 96 | where 97 | prefix i child = assignIds (base ++ "." ++ show i) child 98 | 99 | buildPage :: String -> Document -> Page 100 | buildPage url doc = 101 | let contents = assignIds "" doc 102 | in Page{..} 103 | 104 | test1 :: Page 105 | test1 = buildPage "example.com" $ 106 | node Html [] 107 | [ 108 | ] 109 | 110 | 111 | 112 | getElementById :: String -> Page -> Maybe Document 113 | getElementById str Page{..} = getFirst $ get contents 114 | where 115 | get :: Document -> First Document 116 | get (Text _) = First Nothing 117 | get d@Document{..} = if elementId == str 118 | then First (Just d) 119 | else mconcat $ map get children 120 | 121 | 122 | 123 | data CssSelector 124 | = CssTag HtmlTag 125 | | CssClass HtmlTag String 126 | | CssHash HtmlTag String 127 | | CssAttr HtmlTag Attr String 128 | deriving Show 129 | 130 | pHtmlTag :: Parser HtmlTag 131 | pHtmlTag = choice $ map try 132 | [ string "html" >> return Html 133 | , string "head" >> return Head 134 | , string "title" >> return Title 135 | , string "body" >> return Body 136 | , string "div" >> return Div 137 | , string "p" >> return P 138 | , string "ol" >> return Ol 139 | , string "ul" >> return Ul 140 | , string "li" >> return Li 141 | , string "form" >> return Form 142 | , string "input" >> return Input 143 | , string "button" >> return Button 144 | ] 145 | 146 | pAttr :: Parser Attr 147 | pAttr = choice 148 | [ string "class" >> return Class 149 | , string "id" >> return Id 150 | ] 151 | 152 | tokenchar :: Parser String 153 | tokenchar = many1 $ oneOf $ ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ['-','_'] 154 | 155 | pCssSelector :: Parser CssSelector 156 | pCssSelector = 157 | choice 158 | [ try $ do 159 | tag <- pHtmlTag 160 | char '.' 161 | classname <- tokenchar 162 | return (CssClass tag classname) 163 | 164 | , try $ do 165 | tag <- pHtmlTag 166 | char '#' 167 | name <- tokenchar 168 | return (CssHash tag name) 169 | 170 | , try $ do 171 | tag <- pHtmlTag 172 | char '[' 173 | attr <- pAttr 174 | char '=' 175 | char '\'' 176 | value <- tokenchar 177 | char '\'' 178 | char ']' 179 | return (CssAttr tag attr value) 180 | 181 | ] <|> do 182 | tag <- pHtmlTag 183 | return (CssTag tag) 184 | 185 | parseCss :: String -> Either ParseError CssSelector 186 | parseCss str = parse pCssSelector "" str 187 | 188 | 189 | cssMatchDocument :: CssSelector -> Document -> [Document] 190 | cssMatchDocument _ (Text _) = [] 191 | cssMatchDocument selector d@Document{..} = 192 | let 193 | match = case selector of 194 | CssTag t -> t == tag 195 | CssClass t c -> t == tag && attrHasValue Class c d 196 | CssHash t h -> t == tag && attrHasValue Id h d 197 | CssAttr t a v -> t == tag && attrHasValue a v d 198 | in 199 | (if match then (d:) else id) $ 200 | concatMap (cssMatchDocument selector) children 201 | 202 | requestPage :: String -> [Page] -> Maybe Page 203 | requestPage _ [] = Nothing 204 | requestPage path (p@Page{..}:ps) = 205 | if url == path 206 | then Just p 207 | else requestPage path ps 208 | -------------------------------------------------------------------------------- /test/Web/Api/WebDriver/Monad/Test/Server/State.hs: -------------------------------------------------------------------------------- 1 | module Web.Api.WebDriver.Monad.Test.Server.State ( 2 | WebDriverServerState() 3 | , defaultWebDriverServerState 4 | , _is_active_session 5 | , _create_session 6 | , _delete_session 7 | , _load_page 8 | , _current_page 9 | , _go_back 10 | , _go_forward 11 | , _get_current_url 12 | , _get_last_selected_element 13 | , _set_last_selected_element 14 | ) where 15 | 16 | import Data.List (delete) 17 | import Web.Api.WebDriver.Monad.Test.Server.Page 18 | 19 | -- | Models the internal state of a WebDriver remote end. 20 | data WebDriverServerState = WebDriverServerState 21 | { _next_session_id :: Int 22 | 23 | , _readiness_state :: Bool 24 | , _active_sessions :: [String] 25 | , _max_active_sessions :: Int 26 | 27 | , _history :: [Page] 28 | , _future :: [Page] 29 | 30 | , _last_selected_element :: Maybe String 31 | 32 | , _current_page :: Page 33 | , _internets :: [Page] 34 | } deriving Show 35 | 36 | defaultWebDriverServerState :: WebDriverServerState 37 | defaultWebDriverServerState = WebDriverServerState 38 | { _next_session_id = 1 39 | 40 | , _readiness_state = True 41 | , _active_sessions = [] 42 | , _max_active_sessions = 1 43 | 44 | , _history = [] 45 | , _future = [] 46 | 47 | , _last_selected_element = Nothing 48 | 49 | , _current_page = _default_page 50 | , _internets = [] 51 | } 52 | 53 | _is_active_session 54 | :: String 55 | -> WebDriverServerState 56 | -> Bool 57 | _is_active_session str st = 58 | elem str (_active_sessions st) 59 | 60 | _create_session 61 | :: WebDriverServerState 62 | -> Maybe (String, WebDriverServerState) 63 | _create_session st = 64 | if True == _readiness_state st 65 | && length (_active_sessions st) < _max_active_sessions st 66 | then 67 | let 68 | _id = show $ _next_session_id st 69 | _st = st 70 | { _next_session_id = 71 | 1 + (_next_session_id st) 72 | , _active_sessions = 73 | _id : _active_sessions st 74 | , _readiness_state = False 75 | } 76 | in Just (_id, _st) 77 | else Nothing 78 | 79 | _delete_session 80 | :: String 81 | -> WebDriverServerState 82 | -> WebDriverServerState 83 | _delete_session str st = st 84 | { _active_sessions = delete str $ _active_sessions st 85 | } 86 | 87 | _get_current_url 88 | :: WebDriverServerState 89 | -> String 90 | _get_current_url = 91 | url . _current_page 92 | 93 | _load_page 94 | :: String 95 | -> WebDriverServerState 96 | -> Maybe WebDriverServerState 97 | _load_page path st = do 98 | let file = fileOnly path 99 | p <- case file of 100 | "success.html" -> return _success_page 101 | "example.com" -> return _success_page 102 | "invalidElementState.html" -> return _invalidElementState_page 103 | "about:blank" -> return pageAboutBlank 104 | _ -> requestPage path (_internets st) 105 | return $ st 106 | { _current_page = p 107 | , _history = (_current_page st) : _history st 108 | } 109 | 110 | _go_back 111 | :: WebDriverServerState 112 | -> WebDriverServerState 113 | _go_back st = case _history st of 114 | [] -> st 115 | p:ps -> st 116 | { _current_page = p 117 | , _future = (_current_page st) : _future st 118 | , _history = ps 119 | } 120 | 121 | _go_forward 122 | :: WebDriverServerState 123 | -> WebDriverServerState 124 | _go_forward st = case _future st of 125 | [] -> st 126 | p:ps -> st 127 | { _current_page = p 128 | , _history = (_current_page st) : _history st 129 | , _future = ps 130 | } 131 | 132 | _get_last_selected_element 133 | :: WebDriverServerState 134 | -> Maybe String 135 | _get_last_selected_element = 136 | _last_selected_element 137 | 138 | _set_last_selected_element 139 | :: String 140 | -> WebDriverServerState 141 | -> WebDriverServerState 142 | _set_last_selected_element elt st = st 143 | { _last_selected_element = Just elt 144 | } 145 | 146 | _default_page :: Page 147 | _default_page = buildPage "localhost" $ 148 | node Html [] 149 | [ node Head [] 150 | [ node Title [] 151 | [ Text "localhost" 152 | ] 153 | ] 154 | , node Body [] 155 | [ 156 | ] 157 | ] 158 | 159 | _success_page :: Page 160 | _success_page = buildPage "success.html" $ 161 | node Html [] 162 | [ node Head [] 163 | [ node Title [] 164 | [ Text "successes" 165 | ] 166 | ] 167 | , node Body [] 168 | [ node Form [] 169 | [ node P [(Id, Just "super-cool")] [] 170 | , node Button [(Id, Just "alert-button")] [] 171 | , node Button [(Id, Just "confirm-button")] [] 172 | , node Button [(Id, Just "prompt-button")] [] 173 | , node Button [(Id, Just "add-cookie-button")] [] 174 | , node Input [(Name, Just "sometext")] [] 175 | ] 176 | , node Div [(Class, Just "test")] [] 177 | ] 178 | ] 179 | 180 | _invalidElementState_page :: Page 181 | _invalidElementState_page = buildPage "invalidElementState.html" $ 182 | node Html [] 183 | [ node Head [] 184 | [ node Title [] 185 | [ Text "successes" 186 | ] 187 | ] 188 | , node Body [] [] 189 | ] 190 | 191 | fileOnly :: String -> String 192 | fileOnly = reverse . takeWhile (/= '/') . reverse 193 | -------------------------------------------------------------------------------- /test/Web/Api/WebDriver/Monad/Test/Session/InvalidElementState.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns, OverloadedStrings #-} 2 | module Web.Api.WebDriver.Monad.Test.Session.InvalidElementState ( 3 | invalidElementStateExit 4 | ) where 5 | 6 | import Data.Typeable (Typeable) 7 | import System.IO 8 | 9 | 10 | import Web.Api.WebDriver 11 | import Test.Tasty.WebDriver 12 | 13 | import qualified Data.Text as Text 14 | 15 | import qualified Test.Tasty as T 16 | import qualified Test.Tasty.ExpectedFailure as TE 17 | 18 | 19 | invalidElementState 20 | :: (Monad eff) 21 | => WDError 22 | -> WebDriverT eff() 23 | invalidElementState e = case e of 24 | ResponseError InvalidElementState _ _ _ _ -> assertSuccess "yay!" 25 | err -> assertFailure $ AssertionComment $ 26 | "Expecting 'invalid element state' but got: " <> Text.pack (show err) 27 | 28 | 29 | invalidElementStateExit 30 | :: (Monad eff) 31 | => (String -> WebDriverT eff() -> T.TestTree) 32 | -> FilePath 33 | -> T.TestTree 34 | invalidElementStateExit buildTestCase dir = 35 | let path = dir ++ "/invalidElementState.html" in 36 | T.testGroup "Invalid Element State" 37 | [ buildTestCase "elementClear" (_test_elementClear_invalid_element_state path) 38 | ] 39 | 40 | 41 | 42 | _test_elementClear_invalid_element_state 43 | :: (Monad eff) => FilePath -> WebDriverT eff() 44 | _test_elementClear_invalid_element_state page = 45 | let 46 | session :: (Monad eff) => WebDriverT eff() 47 | session = do 48 | navigateTo $ Text.pack page 49 | !element <- findElement CssSelector "body" 50 | elementClear element 51 | throwError $ UnexpectedResult IsSuccess "Expecting 'invalid_element_state'" 52 | return () 53 | 54 | in catchError session invalidElementState 55 | -------------------------------------------------------------------------------- /test/Web/Api/WebDriver/Monad/Test/Session/UnknownError.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns, OverloadedStrings #-} 2 | module Web.Api.WebDriver.Monad.Test.Session.UnknownError ( 3 | unknownErrorExit 4 | ) where 5 | 6 | import System.IO 7 | 8 | import Web.Api.WebDriver 9 | import Test.Tasty.WebDriver 10 | 11 | import qualified Test.Tasty as T 12 | import qualified Test.Tasty.ExpectedFailure as TE 13 | 14 | 15 | unknownError 16 | :: (Monad eff) 17 | => WDError 18 | -> WebDriverT eff () 19 | unknownError e = case e of 20 | ResponseError UnknownError _ _ _ _ -> assertSuccess "yay!" 21 | _ -> assertFailure "Expecting 'unknown error'" 22 | 23 | 24 | unknownErrorExit 25 | :: (Monad eff) => (String -> WebDriverT eff () -> T.TestTree) 26 | -> FilePath 27 | -> T.TestTree 28 | unknownErrorExit buildTestCase path = T.testGroup "Unknown Error" 29 | [ buildTestCase "navigateTo" (_test_navigateTo_unknown_error) 30 | ] 31 | 32 | 33 | 34 | _test_navigateTo_unknown_error 35 | :: (Monad eff) => WebDriverT eff () 36 | _test_navigateTo_unknown_error = 37 | let 38 | session = do 39 | navigateTo "https://fake.example" 40 | _ <- throwError $ UnexpectedResult IsSuccess "Expecting 'unknown error'" 41 | return () 42 | 43 | in catchError session unknownError 44 | -------------------------------------------------------------------------------- /test/Web/Api/WebDriver/Types/Test.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings, BangPatterns #-} 2 | module Web.Api.WebDriver.Types.Test ( 3 | tests 4 | ) where 5 | 6 | import Data.Proxy 7 | import qualified Data.Aeson as A 8 | ( ToJSON(..), FromJSON, fromJSON, Result(..), object, Value(..) ) 9 | 10 | import Test.Tasty (TestTree(), testGroup) 11 | import Test.Tasty.QuickCheck as QC (testProperty) 12 | import Test.Tasty.HUnit as HU 13 | 14 | import Web.Api.WebDriver.Types 15 | 16 | 17 | 18 | tests :: TestTree 19 | tests = testGroup "Web.Api.WebDriver.Types" 20 | [ test_fromJson_toJson_id 21 | , test_empty_objects 22 | , test_fromJson_parse_error 23 | ] 24 | 25 | 26 | 27 | -- | Tests the round trip from value to encoded JSON and back. 28 | prop_fromJson_toJson_id 29 | :: (Eq a, Show a, A.ToJSON a, A.FromJSON a) 30 | => a -> Bool 31 | prop_fromJson_toJson_id x = 32 | case A.fromJSON $ A.toJSON x of 33 | A.Error _ -> False 34 | A.Success y -> x == y 35 | 36 | test_fromJson_toJson_id :: TestTree 37 | test_fromJson_toJson_id = testGroup "fromJSON . toJSON == id" 38 | [ QC.testProperty "(Capabilities) fromJSON . toJSON == id" $ 39 | (prop_fromJson_toJson_id :: Capabilities -> Bool) 40 | 41 | , QC.testProperty "(BrowserName) fromJSON . toJSON == id" $ 42 | (prop_fromJson_toJson_id :: BrowserName -> Bool) 43 | 44 | , QC.testProperty "(PlatformName) fromJSON . toJSON == id" $ 45 | (prop_fromJson_toJson_id :: PlatformName -> Bool) 46 | 47 | , QC.testProperty "(FirefoxOptions) fromJSON . toJSON == id" $ 48 | (prop_fromJson_toJson_id :: FirefoxOptions -> Bool) 49 | 50 | , QC.testProperty "(ChromeOptions) fromJSON . toJSON == id" $ 51 | (prop_fromJson_toJson_id :: ChromeOptions -> Bool) 52 | 53 | , QC.testProperty "(ProxyConfig) fromJSON . toJSON == id" $ 54 | (prop_fromJson_toJson_id :: ProxyConfig -> Bool) 55 | 56 | , QC.testProperty "(ProxyType) fromJSON . toJSON == id" $ 57 | (prop_fromJson_toJson_id :: ProxyType -> Bool) 58 | 59 | , QC.testProperty "(HostAndOptionalPort) fromJSON . toJSON == id" $ 60 | (prop_fromJson_toJson_id :: HostAndOptionalPort -> Bool) 61 | 62 | , QC.testProperty "(TimeoutConfig) fromJSON . toJSON == id" $ 63 | (prop_fromJson_toJson_id :: TimeoutConfig -> Bool) 64 | 65 | , QC.testProperty "(InputSource) fromJSON . toJSON == id" $ 66 | (prop_fromJson_toJson_id :: InputSource -> Bool) 67 | 68 | , QC.testProperty "(PointerSubtype) fromJSON . toJSON == id" $ 69 | (prop_fromJson_toJson_id :: PointerSubtype -> Bool) 70 | 71 | , QC.testProperty "(InputSourceParameter) fromJSON . toJSON == id" $ 72 | (prop_fromJson_toJson_id :: InputSourceParameter -> Bool) 73 | 74 | , QC.testProperty "(Action) fromJSON . toJSON == id" $ 75 | (prop_fromJson_toJson_id :: Action -> Bool) 76 | 77 | , QC.testProperty "(ActionType) fromJSON . toJSON == id" $ 78 | (prop_fromJson_toJson_id :: ActionType -> Bool) 79 | 80 | , QC.testProperty "(ActionItem) fromJSON . toJSON == id" $ 81 | (prop_fromJson_toJson_id :: ActionItem -> Bool) 82 | 83 | , QC.testProperty "(LocationStrategy) fromJSON . toJSON == id" $ 84 | (prop_fromJson_toJson_id :: LocationStrategy -> Bool) 85 | 86 | , QC.testProperty "(Rect) fromJSON . toJSON == id" $ 87 | (prop_fromJson_toJson_id :: Rect -> Bool) 88 | 89 | , QC.testProperty "(PromptHandler) fromJSON . toJSON == id" $ 90 | (prop_fromJson_toJson_id :: PromptHandler -> Bool) 91 | 92 | , QC.testProperty "(Cookie) fromJSON . toJSON == id" $ 93 | (prop_fromJson_toJson_id :: Cookie -> Bool) 94 | 95 | , QC.testProperty "(ResponseErrorCode) fromJSON . toJSON == id" $ 96 | (prop_fromJson_toJson_id :: ResponseErrorCode -> Bool) 97 | 98 | , QC.testProperty "(ContextId) fromJSON . toJSON == id" $ 99 | (prop_fromJson_toJson_id :: ContextId -> Bool) 100 | 101 | , QC.testProperty "(ContextType) fromJSON . toJSON == id" $ 102 | (prop_fromJson_toJson_id :: ContextType -> Bool) 103 | 104 | , QC.testProperty "(PrintOptions) fromJSON . toJSON == id" $ 105 | (prop_fromJson_toJson_id :: PrintOptions -> Bool) 106 | 107 | , QC.testProperty "(Orientation) fromJSON . toJSON == id" $ 108 | (prop_fromJson_toJson_id :: Orientation -> Bool) 109 | 110 | , QC.testProperty "(Scale) fromJSON . toJSON == id" $ 111 | (prop_fromJson_toJson_id :: Scale -> Bool) 112 | 113 | , QC.testProperty "(Page) fromJSON . toJSON == id" $ 114 | (prop_fromJson_toJson_id :: Page -> Bool) 115 | 116 | , QC.testProperty "(Margin) fromJSON . toJSON == id" $ 117 | (prop_fromJson_toJson_id :: Margin -> Bool) 118 | 119 | , QC.testProperty "(PageRange) fromJSON . toJSON == id" $ 120 | (prop_fromJson_toJson_id :: PageRange -> Bool) 121 | ] 122 | 123 | 124 | 125 | -- | Empty objects are equivalent to a parsed "object []". 126 | prop_is_empty_object 127 | :: (Eq a, Show a, A.ToJSON a) 128 | => a -> IO () 129 | prop_is_empty_object x = do 130 | let obj = A.toJSON x 131 | if obj == A.object [] 132 | then return () 133 | else assertFailure $ "Expected empty object; got " ++ show obj 134 | 135 | test_empty_objects :: TestTree 136 | test_empty_objects = testGroup "empty objects" 137 | [ HU.testCase "emptyCapabilities is an empty object" $ 138 | prop_is_empty_object emptyCapabilities 139 | 140 | , HU.testCase "emptyProxyConfig is an empty object" $ 141 | prop_is_empty_object emptyProxyConfig 142 | 143 | , HU.testCase "emptyTimeoutConfig is an empty object" $ 144 | prop_is_empty_object emptyTimeoutConfig 145 | 146 | , HU.testCase "emptyActionItem is an empty object" $ 147 | prop_is_empty_object emptyActionItem 148 | 149 | , HU.testCase "emptyCookie is an empty object" $ 150 | prop_is_empty_object emptyCookie 151 | ] 152 | 153 | 154 | 155 | -- | JSON parse errors. 156 | prop_fromJson_parse_error 157 | :: (Eq a, Show a, A.FromJSON a) 158 | => Proxy a -> A.Value -> IO () 159 | prop_fromJson_parse_error x str = 160 | case A.fromJSON str of 161 | A.Error !_ -> return () 162 | A.Success !y -> do 163 | let _ = asProxyTypeOf y x 164 | assertFailure $ "Expected parse failure!" 165 | 166 | test_fromJson_parse_error :: TestTree 167 | test_fromJson_parse_error = testGroup "JSON parse error expected" 168 | [ HU.testCase "BrowserName (unrecognized value)" $ 169 | prop_fromJson_parse_error (Proxy :: Proxy BrowserName) $ 170 | A.String "mosaic" 171 | 172 | , HU.testCase "BrowserName (wrong case)" $ 173 | prop_fromJson_parse_error (Proxy :: Proxy BrowserName) $ 174 | A.String "FIREFOX" 175 | 176 | , HU.testCase "BrowserName (wrong type - object)" $ 177 | prop_fromJson_parse_error (Proxy :: Proxy BrowserName) $ 178 | A.object [("browser","firefox")] 179 | 180 | , HU.testCase "BrowserName (wrong type - bool)" $ 181 | prop_fromJson_parse_error (Proxy :: Proxy BrowserName) $ 182 | A.Bool True 183 | 184 | 185 | , HU.testCase "PlatformName (unrecognized value)" $ 186 | prop_fromJson_parse_error (Proxy :: Proxy PlatformName) $ 187 | A.String "os/2" 188 | 189 | , HU.testCase "PlatformName (wrong case)" $ 190 | prop_fromJson_parse_error (Proxy :: Proxy PlatformName) $ 191 | A.String "MAC" 192 | 193 | , HU.testCase "PlatformName (wrong type - object)" $ 194 | prop_fromJson_parse_error (Proxy :: Proxy PlatformName) $ 195 | A.object [("platform","windows")] 196 | 197 | , HU.testCase "PlatformName (wrong type - bool)" $ 198 | prop_fromJson_parse_error (Proxy :: Proxy PlatformName) $ 199 | A.Bool True 200 | 201 | 202 | , HU.testCase "HostAndOptionalPort (malformed value - ':')" $ 203 | prop_fromJson_parse_error (Proxy :: Proxy HostAndOptionalPort) $ 204 | A.String ":" 205 | 206 | , HU.testCase "HostAndOptionalPort (malformed value - '@:123')" $ 207 | prop_fromJson_parse_error (Proxy :: Proxy HostAndOptionalPort) $ 208 | A.String "@:123" 209 | 210 | , HU.testCase "HostAndOptionalPort (malformed value - 'host:')" $ 211 | prop_fromJson_parse_error (Proxy :: Proxy HostAndOptionalPort) $ 212 | A.String "host:" 213 | 214 | , HU.testCase "HostAndOptionalPort (malformed value - 'host:foo')" $ 215 | prop_fromJson_parse_error (Proxy :: Proxy HostAndOptionalPort) $ 216 | A.String "host:foo" 217 | 218 | , HU.testCase "HostAndOptionalPort (wrong type - object)" $ 219 | prop_fromJson_parse_error (Proxy :: Proxy HostAndOptionalPort) $ 220 | A.object [("platform","windows")] 221 | 222 | , HU.testCase "HostAndOptionalPort (wrong type - bool)" $ 223 | prop_fromJson_parse_error (Proxy :: Proxy HostAndOptionalPort) $ 224 | A.Bool True 225 | 226 | 227 | , HU.testCase "ProxyType (unrecognized value)" $ 228 | prop_fromJson_parse_error (Proxy :: Proxy ProxyType) $ 229 | A.String "lan" 230 | 231 | , HU.testCase "ProxyType (wrong case)" $ 232 | prop_fromJson_parse_error (Proxy :: Proxy ProxyType) $ 233 | A.String "PAC" 234 | 235 | , HU.testCase "ProxyType (wrong type - object)" $ 236 | prop_fromJson_parse_error (Proxy :: Proxy ProxyType) $ 237 | A.object [("proxy","what")] 238 | 239 | , HU.testCase "ProxyType (wrong type - bool)" $ 240 | prop_fromJson_parse_error (Proxy :: Proxy ProxyType) $ 241 | A.Bool True 242 | 243 | 244 | , HU.testCase "LocationStrategy (unrecognized value)" $ 245 | prop_fromJson_parse_error (Proxy :: Proxy LocationStrategy) $ 246 | A.String "tag" 247 | 248 | , HU.testCase "LocationStrategy (wrong case)" $ 249 | prop_fromJson_parse_error (Proxy :: Proxy LocationStrategy) $ 250 | A.String "CSS Selector" 251 | 252 | , HU.testCase "LocationStrategy (wrong type - object)" $ 253 | prop_fromJson_parse_error (Proxy :: Proxy LocationStrategy) $ 254 | A.object [("css","selector")] 255 | 256 | , HU.testCase "LocationStrategy (wrong type - bool)" $ 257 | prop_fromJson_parse_error (Proxy :: Proxy LocationStrategy) $ 258 | A.Bool True 259 | 260 | 261 | , HU.testCase "InputSource (unrecognized value)" $ 262 | prop_fromJson_parse_error (Proxy :: Proxy InputSource) $ 263 | A.String "keyboard" 264 | 265 | , HU.testCase "InputSource (wrong case)" $ 266 | prop_fromJson_parse_error (Proxy :: Proxy InputSource) $ 267 | A.String "NULL" 268 | 269 | , HU.testCase "InputSource (wrong type - object)" $ 270 | prop_fromJson_parse_error (Proxy :: Proxy InputSource) $ 271 | A.object [("key","board")] 272 | 273 | , HU.testCase "InputSource (wrong type - bool)" $ 274 | prop_fromJson_parse_error (Proxy :: Proxy InputSource) $ 275 | A.Bool True 276 | 277 | 278 | , HU.testCase "PointerSubtype (unrecognized value)" $ 279 | prop_fromJson_parse_error (Proxy :: Proxy PointerSubtype) $ 280 | A.String "stylus" 281 | 282 | , HU.testCase "PointerSubtype (wrong case)" $ 283 | prop_fromJson_parse_error (Proxy :: Proxy PointerSubtype) $ 284 | A.String "Mouse" 285 | 286 | , HU.testCase "PointerSubtype (wrong type - object)" $ 287 | prop_fromJson_parse_error (Proxy :: Proxy PointerSubtype) $ 288 | A.object [("track","pad")] 289 | 290 | , HU.testCase "PointerSubtype (wrong type - bool)" $ 291 | prop_fromJson_parse_error (Proxy :: Proxy PointerSubtype) $ 292 | A.Bool True 293 | 294 | 295 | , HU.testCase "ActionType (unrecognized value)" $ 296 | prop_fromJson_parse_error (Proxy :: Proxy ActionType) $ 297 | A.String "keypress" 298 | 299 | , HU.testCase "ActionType (wrong case)" $ 300 | prop_fromJson_parse_error (Proxy :: Proxy ActionType) $ 301 | A.String "Pause" 302 | 303 | , HU.testCase "ActionType (wrong type - object)" $ 304 | prop_fromJson_parse_error (Proxy :: Proxy ActionType) $ 305 | A.object [("click","button")] 306 | 307 | , HU.testCase "ActionType (wrong type - bool)" $ 308 | prop_fromJson_parse_error (Proxy :: Proxy ActionType) $ 309 | A.Bool True 310 | 311 | 312 | , HU.testCase "PromptHandler (unrecognized value)" $ 313 | prop_fromJson_parse_error (Proxy :: Proxy PromptHandler) $ 314 | A.String "check" 315 | 316 | , HU.testCase "PromptHandler (wrong case)" $ 317 | prop_fromJson_parse_error (Proxy :: Proxy PromptHandler) $ 318 | A.String "Dismiss" 319 | 320 | , HU.testCase "PromptHandler (wrong type - object)" $ 321 | prop_fromJson_parse_error (Proxy :: Proxy PromptHandler) $ 322 | A.object [("accept","alert")] 323 | 324 | , HU.testCase "PromptHandler (wrong type - bool)" $ 325 | prop_fromJson_parse_error (Proxy :: Proxy PromptHandler) $ 326 | A.Bool True 327 | ] 328 | -------------------------------------------------------------------------------- /test/page/invalidElementState.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Invalid Element State Tests 4 | 5 | 6 |

Invalid Element State Tests

7 |

A paragraph

8 | A Link 9 |
A classy div
10 |
11 | An input box:
12 | 13 |
14 |

Super Cool Text

15 | 16 |

Alerts

17 | 18 | 19 | 20 | 21 | 34 | 35 |

Cookies

36 | 37 | 38 | 43 | 44 | 45 | -------------------------------------------------------------------------------- /test/page/stdin.txt: -------------------------------------------------------------------------------- 1 | To have no errors 2 | Would be life without meaning 3 | No struggle, no joy 4 | -------------------------------------------------------------------------------- /test/page/success.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Success Tests 4 | 5 | 6 |

Success Tests

7 |

A paragraph

8 | A Link 9 |
A classy div
10 |
11 | An input box:
12 | 13 |
14 |

Super Cool Text

15 | 16 |

Alerts

17 | 18 | 19 | 20 | 21 | 34 | 35 |

Cookies

36 | 37 | 38 | 43 | 44 | 45 | -------------------------------------------------------------------------------- /webdriver-w3c.cabal: -------------------------------------------------------------------------------- 1 | name: webdriver-w3c 2 | version: 0.0.3 3 | description: Please see the README on Github at 4 | homepage: https://github.com/nbloomf/webdriver-w3c#readme 5 | bug-reports: https://github.com/nbloomf/webdriver-w3c/issues 6 | author: Nathan Bloomfield 7 | maintainer: nathan.bloomfield@a8c.com 8 | copyright: 2018 Automattic, Inc. 9 | license: GPL-3 10 | license-file: LICENSE 11 | build-type: Simple 12 | cabal-version: 1.20 13 | category: web, webdriver, testing 14 | synopsis: Bindings to the WebDriver API 15 | 16 | extra-source-files: 17 | CHANGELOG.md 18 | README.md 19 | 20 | source-repository head 21 | type: git 22 | location: https://github.com/nbloomf/webdriver-w3c 23 | 24 | 25 | 26 | library 27 | default-language: Haskell2010 28 | hs-source-dirs: src 29 | ghc-options: 30 | -fwarn-incomplete-patterns 31 | 32 | build-depends: 33 | base >=4.12 && <5 34 | 35 | , aeson >=1.2.4.0 36 | , aeson-pretty >=0.8.5 37 | , base64-bytestring >=1.0.0.1 38 | , bytestring >=0.10.8.2 39 | , containers >=0.5.10.2 40 | , directory >=1.3.0.2 41 | , exceptions >=0.8.3 42 | , http-client >=0.5.10 43 | , http-types >=0.12.1 44 | , JuicyPixels >=3.2.9.4 45 | , lens >=4.16 46 | , lens-aeson >=1.0.2 47 | , network-uri >= 2.6 48 | , QuickCheck >=2.10.1 49 | , random >=1.1 50 | , scientific >=0.3.5.2 51 | , script-monad >=0.0.3 52 | , SHA >=1.6.4.2 53 | , stm >=2.4.5.0 54 | , tasty >=1.0.1.1 55 | , tasty-expected-failure >=0.11.1.1 56 | , text >=1.2.3.0 57 | , time >=1.8.0.2 58 | , transformers >=0.5.5.0 59 | , unordered-containers >=0.2.9.0 60 | , uri-encode >=1.5.0.5 61 | , vector >=0.12.0.1 62 | , wreq >=0.5.2 63 | 64 | exposed-modules: 65 | Test.Tasty.WebDriver 66 | Test.Tasty.WebDriver.Config 67 | Web.Api.WebDriver.Assert 68 | Web.Api.WebDriver 69 | Web.Api.WebDriver.Classes 70 | Web.Api.WebDriver.Endpoints 71 | Web.Api.WebDriver.Helpers 72 | Web.Api.WebDriver.Monad 73 | Web.Api.WebDriver.Types 74 | Web.Api.WebDriver.Types.Keyboard 75 | Web.Api.WebDriver.Uri 76 | 77 | 78 | 79 | executable webdriver-w3c-intro 80 | default-language: Haskell2010 81 | main-is: Main.lhs 82 | hs-source-dirs: app 83 | ghc-options: 84 | -threaded -rtsopts -with-rtsopts=-N 85 | build-depends: 86 | webdriver-w3c 87 | , base >=4.7 && <5 88 | 89 | , tasty >=1.0.1.1 90 | , transformers >=0.5.5.0 91 | , text >=1.2.3.0 92 | 93 | 94 | 95 | executable wd-tasty-demo 96 | default-language: Haskell2010 97 | main-is: TastyDemo.lhs 98 | hs-source-dirs: app 99 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 100 | build-depends: 101 | webdriver-w3c 102 | , base >=4.7 && <5 103 | 104 | , text >=1.2.3.0 105 | , tasty >=1.0.1.1 106 | , tasty-expected-failure >=0.11.1.1 107 | 108 | 109 | 110 | executable wd-parallel-stress-test 111 | default-language: Haskell2010 112 | main-is: ParallelStressTest.hs 113 | hs-source-dirs: app 114 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 115 | build-depends: 116 | webdriver-w3c 117 | , base >=4.7 && <5 118 | 119 | , text >=1.2.3.0 120 | , tasty >=1.0.1.1 121 | 122 | 123 | 124 | executable wd-repl-demo 125 | default-language: Haskell2010 126 | main-is: ReplDemo.hs 127 | hs-source-dirs: app 128 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 129 | build-depends: 130 | webdriver-w3c 131 | , base >=4.7 && <5 132 | 133 | , text >=1.2.3.0 134 | , tasty >=1.0.1.1 135 | 136 | 137 | 138 | test-suite webdriver-w3c-test 139 | default-language: Haskell2010 140 | type: exitcode-stdio-1.0 141 | main-is: Main.hs 142 | hs-source-dirs: test 143 | ghc-options: 144 | -threaded -rtsopts -with-rtsopts=-N 145 | build-depends: 146 | webdriver-w3c 147 | , base >=4.7 && <5 148 | 149 | , aeson >=1.2.4.0 150 | , base64-bytestring >=1.0.0.1 151 | , bytestring >=0.10.8.2 152 | , containers >=0.5.10.2 153 | , directory >=1.3.0.2 154 | , exceptions >=0.8.3 155 | , http-client >=0.5.10 156 | , http-types >=0.12.1 157 | , JuicyPixels >=3.2.9.4 158 | , lens >=4.16 159 | , lens-aeson >=1.0.2 160 | , parsec >=3.1.13.0 161 | , QuickCheck >=2.10.1 162 | , random >=1.1 163 | , unordered-containers >=0.2.9.0 164 | , scientific >=0.3.5.2 165 | , script-monad >=0.0.1 166 | , tasty >=1.0.1.1 167 | , tasty-expected-failure >=0.11.1.1 168 | , tasty-hunit >=0.10.0.1 169 | , tasty-quickcheck >=0.9.2 170 | , time >=1.8.0.2 171 | , text >=1.2.3.0 172 | , transformers >=0.5.5.0 173 | , vector >=0.12.0.1 174 | , wreq >=0.5.2 175 | 176 | other-modules: 177 | Test.Tasty.WebDriver.Config.Test 178 | Web.Api.WebDriver.Assert.Test 179 | Web.Api.WebDriver.Monad.Test 180 | Web.Api.WebDriver.Monad.Test.Server 181 | Web.Api.WebDriver.Monad.Test.Server.Page 182 | Web.Api.WebDriver.Monad.Test.Server.State 183 | Web.Api.WebDriver.Monad.Test.Session.Success 184 | Web.Api.WebDriver.Monad.Test.Session.InvalidElementState 185 | Web.Api.WebDriver.Monad.Test.Session.UnknownError 186 | Web.Api.WebDriver.Types.Test 187 | --------------------------------------------------------------------------------