diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,3 @@
+# Changelog for sandwich-webdriver
+
+## Unreleased changes
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Tom McLaughlin (c) 2021
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Tom McLaughlin nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,1 @@
+# sandwich-webdriver
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/app/Main.hs b/app/Main.hs
new file mode 100644
--- /dev/null
+++ b/app/Main.hs
@@ -0,0 +1,96 @@
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+module Main where
+
+import Control.Concurrent
+import Control.Monad.IO.Class
+import Data.Maybe
+import Data.String.Interpolate
+import Data.Time.Clock
+import Test.Sandwich
+import Test.Sandwich.Formatters.Print
+import Test.Sandwich.Formatters.TerminalUI
+import Test.Sandwich.WebDriver
+import Test.Sandwich.WebDriver.Windows
+import Test.WebDriver
+
+simple :: TopSpec
+simple = introduceWebDriver wdOptions $ do
+  it "does the thing 1" $ withSession1 $ do
+    openPage "http://www.google.com"
+    setWindowLeftSide
+    search <- findElem (ByCSS [i|input[title="Search"]|])
+    click search
+    sendKeys "asdf" search
+    liftIO $ threadDelay 1000000
+    sendKeys "fdsa" search
+    liftIO $ threadDelay 1000000
+    sendKeys "jkl" search
+    liftIO $ threadDelay 1000000
+    findElem (ByCSS ".does-not-exist")
+    expectationFailure "OH NO"
+  -- it "does the thing 2" $ withSession2 $ do
+  --   openPage "http://www.cnn.com"
+  --   setWindowRightSide
+  --   liftIO $ threadDelay 1000000
+
+-- concurrent :: TopSpec
+-- concurrent = introduceWebDriver wdOptions $ parallel $ do
+--   it "does the thing 1" $ withSession1 $ do
+--     openPage "http://www.google.com"
+--     setWindowLeftSide
+--     liftIO $ threadDelay 10000000
+--   it "does the thing 2" $ withSession2 $ do
+--     openPage "http://www.cnn.com"
+--     setWindowRightSide
+--     liftIO $ threadDelay 10000000
+
+-- pooled :: TopSpec
+-- pooled = do
+--   introduce "WebDriver pool" webdriverPool doCreatePool (liftIO . purgePool) $ parallel $ do
+--     it "works" (2 `shouldBe` 2)
+
+--     claimWebDriver $ do
+--       it "does the thing 1" $ withSession1 $ do
+--         openPage "http://www.google.com"
+--         setWindowLeftSide
+--         liftIO $ threadDelay 1000000
+
+--     claimWebDriver $ do
+--       it "does the thing 2" $ withSession1 $ do
+--         openPage "http://www.cnn.com"
+--         setWindowRightSide
+--         liftIO $ threadDelay 1000000
+
+-- doCreatePool = do
+--   maybeRunRoot <- getRunRoot
+--   let runRoot = fromMaybe "/tmp" maybeRunRoot
+--   liftIO $ createPool (allocateWebDriver' runRoot wdOptions) cleanupWebDriver' 1 (5) 4
+
+-- claimWebDriver subspec = introduceWith "Claim webdriver" webdriver wrappedAction subspec
+--   where wrappedAction action = do
+--           pool <- getContext webdriverPool
+--           debug "Trying to claim webdriver"
+--           withResource pool (liftIO . action)
+
+-- webdriverPool = Label :: Label "webdriverPool" (Pool WdSession)
+
+wdOptions = (defaultWdOptions "/tmp/tools") {
+  -- capabilities = chromeCapabilities
+  capabilities = firefoxCapabilities
+  -- capabilities = headlessFirefoxCapabilities
+  , saveSeleniumMessageHistory = Always
+  -- , runMode = Normal
+  , runMode = RunHeadless defaultHeadlessConfig
+  }
+
+testOptions = defaultOptions {
+  optionsTestArtifactsDirectory = TestArtifactsGeneratedDirectory "test_runs" (show <$> getCurrentTime)
+  -- , optionsFormatters = [SomeFormatter defaultTerminalUIFormatter]
+  , optionsFormatters = [SomeFormatter defaultPrintFormatter]
+  }
+
+main :: IO ()
+main = runSandwich testOptions simple
diff --git a/app/Simple.hs b/app/Simple.hs
new file mode 100644
--- /dev/null
+++ b/app/Simple.hs
@@ -0,0 +1,22 @@
+
+module Simple where
+
+import Test.Sandwich
+import Test.Sandwich.WebDriver
+import Test.WebDriver
+
+wdOptions = (defaultWdOptions "/tmp/tools") {
+  capabilities = firefoxCapabilities
+  , runMode = RunHeadless defaultHeadlessConfig
+  }
+
+spec :: TopSpec
+spec = introduceWebDriver wdOptions $ do
+  it "opens Google and searches" $ withSession1 $ do
+    openPage "http://www.google.com"
+    search <- findElem (ByCSS "input[title='Search']")
+    click search
+    sendKeys "asdf\n" search
+
+main :: IO ()
+main = runSandwich defaultOptions spec
diff --git a/sandwich-webdriver.cabal b/sandwich-webdriver.cabal
new file mode 100644
--- /dev/null
+++ b/sandwich-webdriver.cabal
@@ -0,0 +1,182 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.33.0.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: 1445634cb05bff8d8f14f1859f68e0088405fbc2410b4efaa022d2e4d7e004e0
+
+name:           sandwich-webdriver
+version:        0.1.0.0
+description:    Please see the README on GitHub at <https://github.com/githubuser/sandwich-webdriver#readme>
+homepage:       https://github.com/codedownio/sandwich-webdriver#readme
+bug-reports:    https://github.com/codedownio/sandwich-webdriver/issues
+author:         Tom McLaughlin
+maintainer:     tom@codedown.io
+copyright:      2021 Tom McLaughlin
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    README.md
+    ChangeLog.md
+
+source-repository head
+  type: git
+  location: https://github.com/codedownio/sandwich-webdriver
+
+library
+  exposed-modules:
+      Test.Sandwich.WebDriver
+      Test.Sandwich.WebDriver.Class
+      Test.Sandwich.WebDriver.Config
+      Test.Sandwich.WebDriver.Internal.Action
+      Test.Sandwich.WebDriver.Internal.Binaries
+      Test.Sandwich.WebDriver.Internal.Binaries.Util
+      Test.Sandwich.WebDriver.Internal.Capabilities
+      Test.Sandwich.WebDriver.Internal.Ports
+      Test.Sandwich.WebDriver.Internal.Screenshots
+      Test.Sandwich.WebDriver.Internal.StartWebDriver
+      Test.Sandwich.WebDriver.Internal.StartWebDriver.Xvfb
+      Test.Sandwich.WebDriver.Internal.Types
+      Test.Sandwich.WebDriver.Internal.Util
+      Test.Sandwich.WebDriver.Internal.Video
+      Test.Sandwich.WebDriver.Types
+      Test.Sandwich.WebDriver.Video
+      Test.Sandwich.WebDriver.Windows
+  other-modules:
+      Paths_sandwich_webdriver
+  hs-source-dirs:
+      src
+  default-extensions: OverloadedStrings QuasiQuotes NamedFieldPuns RecordWildCards ScopedTypeVariables FlexibleContexts FlexibleInstances LambdaCase
+  ghc-options: -W
+  build-depends:
+      X11
+    , aeson
+    , base <=4.14
+    , containers
+    , convertible
+    , data-default
+    , directory
+    , exceptions
+    , filepath
+    , http-client
+    , http-client-tls
+    , http-conduit
+    , lifted-base
+    , microlens
+    , microlens-aeson
+    , monad-control
+    , monad-logger
+    , mtl
+    , network
+    , process
+    , random
+    , retry
+    , safe
+    , safe-exceptions
+    , sandwich
+    , string-interpolate
+    , temporary
+    , text
+    , time
+    , transformers
+    , unix
+    , unordered-containers
+    , vector
+    , webdriver
+  default-language: Haskell2010
+
+executable sandwich-webdriver-exe
+  main-is: Main.hs
+  other-modules:
+      Simple
+      Paths_sandwich_webdriver
+  hs-source-dirs:
+      app
+  default-extensions: OverloadedStrings QuasiQuotes NamedFieldPuns RecordWildCards ScopedTypeVariables FlexibleContexts FlexibleInstances LambdaCase
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      X11
+    , aeson
+    , base <=4.14
+    , containers
+    , convertible
+    , data-default
+    , directory
+    , exceptions
+    , filepath
+    , http-client
+    , http-client-tls
+    , http-conduit
+    , lifted-base
+    , microlens
+    , microlens-aeson
+    , monad-control
+    , monad-logger
+    , mtl
+    , network
+    , process
+    , random
+    , retry
+    , safe
+    , safe-exceptions
+    , sandwich
+    , sandwich-webdriver
+    , string-interpolate
+    , temporary
+    , text
+    , time
+    , transformers
+    , unix
+    , unordered-containers
+    , vector
+    , webdriver
+  default-language: Haskell2010
+
+test-suite sandwich-webdriver-test
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+      Paths_sandwich_webdriver
+  hs-source-dirs:
+      test
+  default-extensions: OverloadedStrings QuasiQuotes NamedFieldPuns RecordWildCards ScopedTypeVariables FlexibleContexts FlexibleInstances LambdaCase
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      X11
+    , aeson
+    , base <=4.14
+    , containers
+    , convertible
+    , data-default
+    , directory
+    , exceptions
+    , filepath
+    , http-client
+    , http-client-tls
+    , http-conduit
+    , lifted-base
+    , microlens
+    , microlens-aeson
+    , monad-control
+    , monad-logger
+    , mtl
+    , network
+    , process
+    , random
+    , retry
+    , safe
+    , safe-exceptions
+    , sandwich
+    , sandwich-webdriver
+    , string-interpolate
+    , temporary
+    , text
+    , time
+    , transformers
+    , unix
+    , unordered-containers
+    , vector
+    , webdriver
+  default-language: Haskell2010
diff --git a/src/Test/Sandwich/WebDriver.hs b/src/Test/Sandwich/WebDriver.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Sandwich/WebDriver.hs
@@ -0,0 +1,151 @@
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Test.Sandwich.WebDriver (
+  -- * Introducing a WebDriver server
+  introduceWebDriver
+  , introduceWebDriverOptions
+  , addCommandLineOptionsToWdOptions
+
+  -- * Running an example in a given session
+  , withSession
+  , withSession1
+  , withSession2
+
+  -- * Managing sessions
+  , getSessions
+  , closeCurrentSession
+  , closeSession
+  , closeAllSessions
+  , closeAllSessionsExcept
+  , Session
+
+  -- * Lower-level allocation functions
+  , allocateWebDriver
+  , allocateWebDriver'
+  , cleanupWebDriver
+  , cleanupWebDriver'
+
+  -- * Re-exports
+  , module Test.Sandwich.WebDriver.Class
+  , module Test.Sandwich.WebDriver.Config
+  , module Test.Sandwich.WebDriver.Types
+  ) where
+
+import Control.Concurrent.MVar.Lifted
+import Control.Monad.IO.Class
+import Control.Monad.Logger
+import Control.Monad.Reader
+import Data.IORef
+import qualified Data.Map as M
+import Data.Maybe
+import Data.String.Interpolate
+import Test.Sandwich
+import Test.Sandwich.Internal
+import Test.Sandwich.WebDriver.Class
+import Test.Sandwich.WebDriver.Config
+import Test.Sandwich.WebDriver.Internal.Action
+import Test.Sandwich.WebDriver.Internal.StartWebDriver
+import Test.Sandwich.WebDriver.Internal.Types
+import Test.Sandwich.WebDriver.Types
+import qualified Test.WebDriver as W
+import qualified Test.WebDriver.Config as W
+import qualified Test.WebDriver.Session as W
+
+
+-- | This is the main 'introduce' method for creating a WebDriver.
+introduceWebDriver :: (BaseMonadContext m context) => WdOptions -> SpecFree (LabelValue "webdriver" WebDriver :> context) m () -> SpecFree context m ()
+introduceWebDriver wdOptions = introduce "Introduce WebDriver session" webdriver (allocateWebDriver wdOptions) cleanupWebDriver
+
+-- | Same as introduceWebDriver, but merges command line options into the 'WdOptions'.
+introduceWebDriverOptions :: forall a context m. (BaseMonadContext m context, HasCommandLineOptions context a)
+  => WdOptions -> SpecFree (LabelValue "webdriver" WebDriver :> context) m () -> SpecFree context m ()
+introduceWebDriverOptions wdOptions = introduce "Introduce WebDriver session" webdriver alloc cleanupWebDriver
+  where alloc = do
+          clo <- getCommandLineOptions
+          allocateWebDriver (addCommandLineOptionsToWdOptions @a clo wdOptions)
+
+-- | Allocate a WebDriver using the given options.
+allocateWebDriver :: (HasBaseContext context, BaseMonad m) => WdOptions -> ExampleT context m WebDriver
+allocateWebDriver wdOptions = do
+  debug "Beginning allocateWebDriver"
+  maybeRunRoot <- getRunRoot
+  let runRoot = fromMaybe "/tmp" maybeRunRoot
+  startWebDriver wdOptions runRoot
+
+-- | Allocate a WebDriver using the given options and putting logs under the given path.
+allocateWebDriver' :: FilePath -> WdOptions -> IO WebDriver
+allocateWebDriver' runRoot wdOptions = do
+  runNoLoggingT $ startWebDriver wdOptions runRoot
+
+-- | Clean up the given WebDriver.
+cleanupWebDriver :: (HasBaseContext context, BaseMonad m) => WebDriver -> ExampleT context m ()
+cleanupWebDriver sess = do
+  closeAllSessions sess
+  stopWebDriver sess
+
+-- | Clean up the given WebDriver without logging.
+cleanupWebDriver' :: WebDriver -> IO ()
+cleanupWebDriver' sess = do
+  runNoLoggingT $ do
+    closeAllSessions sess
+    stopWebDriver sess
+
+-- | Run a given example using a given Selenium session.
+withSession :: forall m context a. WebDriverMonad m context => Session -> ExampleT (ContextWithSession context) m a -> ExampleT context m a
+withSession session (ExampleT readerMonad) = do
+  WebDriver {..} <- getContext webdriver
+  -- Create new session if necessary (this can throw an exception)
+  sess <- modifyMVar wdSessionMap $ \sessionMap -> case M.lookup session sessionMap of
+    Just sess -> return (sessionMap, sess)
+    Nothing -> do
+      debug [i|Creating session '#{session}'|]
+      sess'' <- liftIO $ W.mkSession wdConfig
+      let sess' = sess'' { W.wdSessHistUpdate = W.unlimitedHistory }
+      sess <- liftIO $ W.runWD sess' $ W.createSession $ W.wdCapabilities wdConfig
+      return (M.insert session sess sessionMap, sess)
+
+  ref <- liftIO $ newIORef sess
+
+  -- Not used for now, but previous libraries have use a finally to grab the final session on exception.
+  -- We could do the same here, but it's not clear that it's needed.
+  let f :: m a -> m a = id
+
+  ExampleT (withReaderT (\ctx -> LabelValue (session, ref) :> ctx) $ mapReaderT (mapLoggingT f) readerMonad)
+
+-- | Convenience function. 'withSession1' = 'withSession' "session1"
+withSession1 :: WebDriverMonad m context => ExampleT (ContextWithSession context) m a -> ExampleT context m a
+withSession1 = withSession "session1"
+
+-- | Convenience function. 'withSession2' = 'withSession' "session2"
+withSession2 :: WebDriverMonad m context => ExampleT (ContextWithSession context) m a -> ExampleT context m a
+withSession2 = withSession "session2"
+
+-- | Get all existing session names
+getSessions :: (WebDriverMonad m context, MonadReader context m, HasLabel context "webdriver" WebDriver) => m [Session]
+getSessions = do
+  WebDriver {..} <- getContext webdriver
+  M.keys <$> liftIO (readMVar wdSessionMap)
+
+-- | Merge the options from the 'CommandLineOptions' into some 'WdOptions'.
+addCommandLineOptionsToWdOptions :: CommandLineOptions a -> WdOptions -> WdOptions
+addCommandLineOptionsToWdOptions (CommandLineOptions {optWebdriverOptions=(CommandLineWebdriverOptions {..})}) wdOptions@(WdOptions {..}) = wdOptions {
+  capabilities = case optFirefox of
+    Nothing -> capabilities
+    Just UseFirefox -> firefoxCapabilities
+    Just UseChrome -> chromeCapabilities
+  , runMode = case optDisplay of
+      Nothing -> runMode
+      Just Headless -> RunHeadless defaultHeadlessConfig
+      Just Xvfb -> RunInXvfb (defaultXvfbConfig { xvfbStartFluxbox = optFluxbox })
+      Just Current -> Normal
+  }
diff --git a/src/Test/Sandwich/WebDriver/Class.hs b/src/Test/Sandwich/WebDriver/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Sandwich/WebDriver/Class.hs
@@ -0,0 +1,15 @@
+
+module Test.Sandwich.WebDriver.Class (
+  -- * The main WebDriver type
+  WebDriver
+  , getWdOptions
+  , getDisplayNumber
+  , getXvfbSession
+  , getWebDriverName
+
+  -- * The Xvfb session
+  , XvfbSession(..)
+  ) where
+
+
+import Test.Sandwich.WebDriver.Internal.Types
diff --git a/src/Test/Sandwich/WebDriver/Config.hs b/src/Test/Sandwich/WebDriver/Config.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Sandwich/WebDriver/Config.hs
@@ -0,0 +1,52 @@
+
+module Test.Sandwich.WebDriver.Config (
+  -- * Main options
+  WdOptions
+  , defaultWdOptions
+  , runMode
+  , seleniumToUse
+  , chromeDriverToUse
+  , geckoDriverToUse
+  , capabilities
+  , httpManager
+  , httpRetryCount
+  , saveSeleniumMessageHistory
+
+  -- * Run mode constructors
+  , RunMode(..)
+
+  -- ** Xvfb mode
+  , XvfbConfig
+  , defaultXvfbConfig
+  , xvfbResolution
+  , xvfbStartFluxbox
+
+  -- ** Headless mode
+  , HeadlessConfig
+  , defaultHeadlessConfig
+  , headlessResolution
+
+  -- * Binary fetching options
+  , SeleniumToUse(..)
+  , ChromeDriverToUse(..)
+  , GeckoDriverToUse(..)
+
+  -- * Miscellaneous constructors
+  , WhenToSave(..)
+
+  -- * Manually obtaining binaries
+  , obtainSelenium
+  , obtainChromeDriver
+  , obtainGeckoDriver
+
+  -- * Browser capabilities
+  , chromeCapabilities
+  , headlessChromeCapabilities
+  , firefoxCapabilities
+  , headlessFirefoxCapabilities
+
+  ) where
+
+import Test.Sandwich.WebDriver.Internal.Binaries
+import Test.Sandwich.WebDriver.Internal.Capabilities
+import Test.Sandwich.WebDriver.Internal.Types
diff --git a/src/Test/Sandwich/WebDriver/Internal/Action.hs b/src/Test/Sandwich/WebDriver/Internal/Action.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Sandwich/WebDriver/Internal/Action.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE ViewPatterns, LambdaCase, QuasiQuotes, RecordWildCards, NamedFieldPuns, ScopedTypeVariables, DataKinds #-}
+
+module Test.Sandwich.WebDriver.Internal.Action where
+
+import Control.Concurrent.MVar.Lifted
+import Control.Exception.Safe
+import Control.Monad
+import Control.Monad.IO.Class
+import Control.Monad.Logger
+import Control.Monad.Reader
+import Control.Monad.Trans.Control (MonadBaseControl)
+import qualified Data.Map as M
+import Data.String.Interpolate
+import GHC.Stack
+import Test.Sandwich
+import Test.Sandwich.WebDriver.Internal.Types
+import Test.Sandwich.WebDriver.Internal.Util
+import qualified Test.WebDriver as W
+
+
+-- | Close the given sessions
+closeSession :: (HasCallStack, MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m) => Session -> WebDriver -> m ()
+closeSession session (WebDriver {wdSessionMap}) = do
+  toClose <- modifyMVar wdSessionMap $ \sessionMap ->
+    case M.lookup session sessionMap of
+      Nothing -> return (sessionMap, Nothing)
+      Just x -> return (M.delete session sessionMap, Just x)
+
+  whenJust toClose $ \sess -> liftIO $ W.runWD sess W.closeSession
+
+-- | Close all sessions except those listed
+closeAllSessionsExcept :: (HasCallStack, MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m) => [Session] -> WebDriver -> m ()
+closeAllSessionsExcept toKeep (WebDriver {wdSessionMap}) = do
+  toClose <- modifyMVar wdSessionMap $ return . M.partitionWithKey (\name _ -> name `elem` toKeep)
+
+  forM_ (M.toList toClose) $ \(name, sess) ->
+    catch (liftIO $ W.runWD sess W.closeSession)
+          (\(e :: SomeException) -> warn [i|Failed to destroy session '#{name}': '#{e}'|])
+
+-- | Close all sessions
+closeAllSessions :: (HasCallStack, MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m) => WebDriver -> m ()
+closeAllSessions = closeAllSessionsExcept []
+
+-- | Close the current session
+closeCurrentSession :: (HasCallStack, MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m, MonadReader context m, HasLabel context "webdriver" WebDriver, HasLabel context "webdriverSession" WebDriverSession) => m ()
+closeCurrentSession = do
+  webDriver <- getContext webdriver
+  (session, _) <- getContext webdriverSession
+  closeSession session webDriver
diff --git a/src/Test/Sandwich/WebDriver/Internal/Binaries.hs b/src/Test/Sandwich/WebDriver/Internal/Binaries.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Sandwich/WebDriver/Internal/Binaries.hs
@@ -0,0 +1,165 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE CPP, QuasiQuotes, ScopedTypeVariables, NamedFieldPuns, Rank2Types #-}
+
+module Test.Sandwich.WebDriver.Internal.Binaries (
+  obtainSelenium
+  , obtainChromeDriver
+  , obtainGeckoDriver
+  , downloadSeleniumIfNecessary
+  , downloadChromeDriverIfNecessary
+  ) where
+
+import Control.Monad
+import Control.Monad.IO.Class
+import Control.Monad.Logger
+import Control.Monad.Trans.Control (MonadBaseControl)
+import Control.Monad.Trans.Except
+import Data.String.Interpolate
+import qualified Data.Text as T
+import GHC.Stack
+import System.Directory
+import System.FilePath
+import System.Process
+import Test.Sandwich.Logging
+import Test.Sandwich.WebDriver.Internal.Binaries.Util
+import Test.Sandwich.WebDriver.Internal.Types
+import Test.Sandwich.WebDriver.Internal.Util
+
+type Constraints m = (HasCallStack, MonadLogger m, MonadIO m, MonadBaseControl IO m)
+
+-- * Obtaining binaries
+
+  -- TODO: remove curl dependencies here
+
+-- | Manually obtain a Selenium server JAR file, according to the 'SeleniumToUse' policy,
+-- storing it under the provided 'FilePath' if necessary and returning the exact path.
+obtainSelenium :: (MonadIO m, MonadLogger m) => FilePath -> SeleniumToUse -> m (Either T.Text FilePath)
+obtainSelenium toolsDir (DownloadSeleniumFrom url) = do
+  let seleniumPath = [i|#{toolsDir}/selenium-server-standalone.jar|]
+  liftIO $ createDirectoryIfMissing True (takeDirectory seleniumPath)
+  unlessM (liftIO $ doesFileExist seleniumPath) $
+    void $ liftIO $ readCreateProcess (shell [i|curl #{url} -o #{seleniumPath}|]) ""
+  return $ Right seleniumPath
+obtainSelenium toolsDir DownloadSeleniumDefault = do
+  let seleniumPath = [i|#{toolsDir}/selenium-server-standalone-3.141.59.jar|]
+  liftIO $ createDirectoryIfMissing True (takeDirectory seleniumPath)
+  unlessM (liftIO $ doesFileExist seleniumPath) $
+    void $ liftIO $ readCreateProcess (shell [i|curl https://selenium-release.storage.googleapis.com/3.141/selenium-server-standalone-3.141.59.jar -o #{seleniumPath}|]) ""
+  return $ Right seleniumPath
+obtainSelenium _ (UseSeleniumAt path) =
+  (liftIO $ doesFileExist path) >>= \case
+    False -> return $ Left [i|Path '#{path}' didn't exist|]
+    True -> return $ Right path
+
+-- | Manually obtain a chromedriver binary, according to the 'ChromeDriverToUse' policy,
+-- storing it under the provided 'FilePath' if necessary and returning the exact path.
+obtainChromeDriver :: (MonadIO m, MonadLogger m, MonadBaseControl IO m) => FilePath -> ChromeDriverToUse -> m (Either T.Text FilePath)
+obtainChromeDriver toolsDir (DownloadChromeDriverFrom url) = do
+  let path = [i|#{toolsDir}/#{chromeDriverExecutable}|]
+  liftIO $ createDirectoryIfMissing True (takeDirectory path)
+  unlessM (liftIO $ doesFileExist path) $
+    void $ liftIO $ readCreateProcess (shell [i|curl #{url} -o #{path}|]) ""
+  return $ Right path
+obtainChromeDriver toolsDir (DownloadChromeDriverVersion chromeDriverVersion) = runExceptT $ do
+  let path = getChromeDriverPath toolsDir chromeDriverVersion
+  (liftIO $ doesFileExist path) >>= \case
+    True -> return path
+    False -> do
+      let downloadPath = getChromeDriverDownloadUrl chromeDriverVersion detectPlatform
+      ExceptT $ downloadAndUnzipToPath downloadPath path
+      return path
+obtainChromeDriver toolsDir DownloadChromeDriverAutodetect = runExceptT $ do
+  version <- ExceptT $ liftIO getChromeDriverVersion
+  ExceptT $ obtainChromeDriver toolsDir (DownloadChromeDriverVersion version)
+obtainChromeDriver _ (UseChromeDriverAt path) =
+  (liftIO $ doesFileExist path) >>= \case
+    False -> return $ Left [i|Path '#{path}' didn't exist|]
+    True -> return $ Right path
+
+-- | Manually obtain a geckodriver binary, according to the 'GeckoDriverToUse' policy,
+-- storing it under the provided 'FilePath' if necessary and returning the exact path.
+obtainGeckoDriver :: (MonadIO m, MonadLogger m, MonadBaseControl IO m) => FilePath -> GeckoDriverToUse -> m (Either T.Text FilePath)
+obtainGeckoDriver toolsDir (DownloadGeckoDriverFrom url) = do
+  let path = [i|#{toolsDir}/#{geckoDriverExecutable}|]
+  liftIO $ createDirectoryIfMissing True (takeDirectory path)
+  unlessM (liftIO $ doesFileExist path) $
+    void $ liftIO $ readCreateProcess (shell [i|curl #{url} -o #{path}|]) ""
+  return $ Right path
+obtainGeckoDriver toolsDir (DownloadGeckoDriverVersion geckoDriverVersion) = runExceptT $ do
+  let path = getGeckoDriverPath toolsDir geckoDriverVersion
+  (liftIO $ doesFileExist path) >>= \case
+    True -> return path
+    False -> do
+      let downloadPath = getGeckoDriverDownloadUrl geckoDriverVersion detectPlatform
+      ExceptT $ downloadAndUntarballToPath downloadPath path
+      return path
+obtainGeckoDriver toolsDir DownloadGeckoDriverAutodetect = runExceptT $ do
+  version <- ExceptT $ liftIO getGeckoDriverVersion
+  ExceptT $ obtainGeckoDriver toolsDir (DownloadGeckoDriverVersion version)
+obtainGeckoDriver _ (UseGeckoDriverAt path) =
+  (liftIO $ doesFileExist path) >>= \case
+    False -> return $ Left [i|Path '#{path}' didn't exist|]
+    True -> return $ Right path
+
+-- * Lower level helpers
+
+
+downloadSeleniumIfNecessary :: Constraints m => FilePath -> m (Either T.Text FilePath)
+downloadSeleniumIfNecessary toolsDir = leftOnException' $ do
+  let seleniumPath = [i|#{toolsDir}/selenium-server.jar|]
+  (liftIO (doesFileExist seleniumPath) >>= flip unless (downloadSelenium seleniumPath))
+  return seleniumPath
+
+downloadSelenium :: Constraints m => FilePath -> m ()
+downloadSelenium seleniumPath = void $ do
+  info [i|Downloading selenium-server.jar to #{seleniumPath}|]
+  liftIO $ createDirectoryIfMissing True (takeDirectory seleniumPath)
+  liftIO $ readCreateProcess (shell [i|curl https://selenium-release.storage.googleapis.com/3.141/selenium-server-standalone-3.141.59.jar -o #{seleniumPath}|]) ""
+
+downloadChromeDriverIfNecessary' :: Constraints m => FilePath -> ChromeDriverVersion -> m (Either T.Text FilePath)
+downloadChromeDriverIfNecessary' toolsDir chromeDriverVersion = runExceptT $ do
+  let chromeDriverPath = getChromeDriverPath toolsDir chromeDriverVersion
+
+  unlessM (liftIO $ doesFileExist chromeDriverPath) $ do
+    let downloadPath = getChromeDriverDownloadUrl chromeDriverVersion detectPlatform
+    ExceptT $ downloadAndUnzipToPath downloadPath chromeDriverPath
+
+  return chromeDriverPath
+
+downloadChromeDriverIfNecessary :: Constraints m => FilePath -> m (Either T.Text FilePath)
+downloadChromeDriverIfNecessary toolsDir = runExceptT $ do
+  chromeDriverVersion <- ExceptT $ liftIO getChromeDriverVersion
+  ExceptT $ downloadChromeDriverIfNecessary' toolsDir chromeDriverVersion
+
+getChromeDriverPath :: FilePath -> ChromeDriverVersion -> FilePath
+getChromeDriverPath toolsDir (ChromeDriverVersion (w, x, y, z)) = [i|#{toolsDir}/chromedrivers/#{w}.#{x}.#{y}.#{z}/#{chromeDriverExecutable}|]
+
+getGeckoDriverPath :: FilePath -> GeckoDriverVersion -> FilePath
+getGeckoDriverPath toolsDir (GeckoDriverVersion (x, y, z)) = [i|#{toolsDir}/geckodrivers/#{x}.#{y}.#{z}/#{geckoDriverExecutable}|]
+
+chromeDriverExecutable :: T.Text
+chromeDriverExecutable = case detectPlatform of
+  Windows -> "chromedriver.exe"
+  _ -> "chromedriver"
+
+geckoDriverExecutable :: T.Text
+geckoDriverExecutable = case detectPlatform of
+  Windows -> "geckodriver.exe"
+  _ -> "geckodriver"
+
+downloadAndUnzipToPath :: (MonadIO m, MonadBaseControl IO m, MonadLogger m) => T.Text -> FilePath -> m (Either T.Text ())
+downloadAndUnzipToPath downloadPath localPath = leftOnException' $ do
+  info [i|Downloading #{downloadPath} to #{localPath}|]
+  liftIO $ createDirectoryIfMissing True (takeDirectory localPath)
+  liftIO $ void $ readCreateProcess (shell [i|wget -nc -O - #{downloadPath} | gunzip - > #{localPath}|]) ""
+  liftIO $ void $ readCreateProcess (shell [i|chmod u+x #{localPath}|]) ""
+
+downloadAndUntarballToPath :: (MonadIO m, MonadBaseControl IO m, MonadLogger m) => T.Text -> FilePath -> m (Either T.Text ())
+downloadAndUntarballToPath downloadPath localPath = leftOnException' $ do
+  info [i|Downloading #{downloadPath} to #{localPath}|]
+  liftIO $ createDirectoryIfMissing True (takeDirectory localPath)
+  liftIO $ void $ readCreateProcess (shell [i|wget -qO- #{downloadPath} | tar xvz  -C #{takeDirectory localPath}|]) ""
+  liftIO $ void $ readCreateProcess (shell [i|chmod u+x #{localPath}|]) ""
+
+unlessM :: Monad m => m Bool -> m () -> m ()
+unlessM b s = b >>= (\t -> unless t s)
diff --git a/src/Test/Sandwich/WebDriver/Internal/Binaries/Util.hs b/src/Test/Sandwich/WebDriver/Internal/Binaries/Util.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Sandwich/WebDriver/Internal/Binaries/Util.hs
@@ -0,0 +1,125 @@
+{-# LANGUAGE CPP, QuasiQuotes, ScopedTypeVariables, NamedFieldPuns, OverloadedStrings, ViewPatterns #-}
+
+module Test.Sandwich.WebDriver.Internal.Binaries.Util (
+  detectPlatform
+  , detectChromeVersion
+  , getChromeDriverVersion
+  , getChromeDriverDownloadUrl
+  , Platform(..)
+
+  , detectFirefoxVersion
+  , getGeckoDriverVersion
+  , getGeckoDriverDownloadUrl
+  ) where
+
+import Control.Exception
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Except
+import qualified Data.Aeson as A
+import Data.Convertible
+import qualified Data.HashMap.Strict as HM
+import Data.String.Interpolate
+import qualified Data.Text as T
+import Network.HTTP.Client
+import Network.HTTP.Client.TLS
+import Network.HTTP.Conduit (simpleHttp)
+import Safe
+import System.Exit
+import qualified System.Info as SI
+import System.Process
+import Test.Sandwich.WebDriver.Internal.Types
+import Test.Sandwich.WebDriver.Internal.Util
+
+data Platform = Linux | OSX | Windows deriving (Show, Eq)
+
+detectPlatform :: Platform
+detectPlatform =  case SI.os of
+  "windows" -> Windows
+  "linux" -> Linux
+  "darwin" -> OSX
+  _ -> error [i|Couldn't determine host platform from string: '#{SI.os}'|]
+
+-- * Chrome
+
+detectChromeVersion :: IO (Either T.Text ChromeVersion)
+detectChromeVersion = leftOnException $ runExceptT $ do
+  (exitCode, stdout, stderr) <- liftIO $ readCreateProcessWithExitCode (shell "google-chrome --version | grep -Eo \"[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\"") ""
+
+  rawString <- case exitCode of
+                 ExitFailure _ -> throwE [i|Couldn't parse google-chrome version. Stdout: '#{stdout}'. Stderr: '#{stderr}'|]
+                 ExitSuccess -> return $ T.strip $ convert stdout
+
+  case T.splitOn "." rawString of
+    [tReadMay -> Just w, tReadMay -> Just x, tReadMay -> Just y, tReadMay -> Just z] -> return $ ChromeVersion (w, x, y, z)
+    _ -> throwE [i|Failed to parse google-chrome version from string: '#{rawString}'|]
+
+getChromeDriverVersion :: IO (Either T.Text ChromeDriverVersion)
+getChromeDriverVersion = runExceptT $ do
+  chromeVersion <- ExceptT $ liftIO detectChromeVersion
+  ExceptT $ getChromeDriverVersion' chromeVersion
+
+getChromeDriverVersion' :: ChromeVersion -> IO (Either T.Text ChromeDriverVersion)
+getChromeDriverVersion' (ChromeVersion (w, x, y, _)) = do
+  let url = [i|https://chromedriver.storage.googleapis.com/LATEST_RELEASE_#{w}.#{x}.#{y}|]
+  handle (\(e :: HttpException) -> do
+            return $ Left [i|Error when requesting '#{url}': '#{e}'|]
+         )
+         (do
+             result :: T.Text <- convert <$> simpleHttp url
+             case T.splitOn "." result of
+               [tReadMay -> Just w, tReadMay -> Just x, tReadMay -> Just y, tReadMay -> Just z] -> return $ Right $ ChromeDriverVersion (w, x, y, z)
+               _ -> return $ Left [i|Failed to parse chromedriver version from string: '#{result}'|]
+         )
+
+getChromeDriverDownloadUrl :: ChromeDriverVersion -> Platform -> T.Text
+getChromeDriverDownloadUrl (ChromeDriverVersion (w, x, y, z)) Linux = [i|https://chromedriver.storage.googleapis.com/#{w}.#{x}.#{y}.#{z}/chromedriver_linux64.zip|]
+getChromeDriverDownloadUrl (ChromeDriverVersion (w, x, y, z)) OSX = [i|https://chromedriver.storage.googleapis.com/#{w}.#{x}.#{y}.#{z}/chromedriver_mac64.zip|]
+getChromeDriverDownloadUrl (ChromeDriverVersion (w, x, y, z)) Windows = [i|https://chromedriver.storage.googleapis.com/#{w}.#{x}.#{y}.#{z}/chromedriver_win32.zip|]
+
+-- * Firefox
+
+detectFirefoxVersion :: IO (Either T.Text FirefoxVersion)
+detectFirefoxVersion = leftOnException $ runExceptT $ do
+  (exitCode, stdout, stderr) <- liftIO $ readCreateProcessWithExitCode (shell "firefox --version | grep -Eo \"[0-9]+\\.[0-9]+(\\.[0-9]+)?\"") ""
+
+  rawString <- case exitCode of
+                 ExitFailure _ -> throwE [i|Couldn't parse firefox version. Stdout: '#{stdout}'. Stderr: '#{stderr}'|]
+                 ExitSuccess -> return $ T.strip $ convert stdout
+
+  case T.splitOn "." rawString of
+    [tReadMay -> Just x, tReadMay -> Just y] -> return $ FirefoxVersion (x, y, 0)
+    [tReadMay -> Just x, tReadMay -> Just y, tReadMay -> Just z] -> return $ FirefoxVersion (x, y, z)
+    _ -> throwE [i|Failed to parse firefox version from string: '#{rawString}'|]
+
+
+getGeckoDriverVersion :: IO (Either T.Text GeckoDriverVersion)
+getGeckoDriverVersion = runExceptT $ do
+  -- firefoxVersion <- ExceptT $ liftIO detectFirefoxVersion
+
+  -- Just get the latest release on GitHub
+  let url = [i|https://api.github.com/repos/mozilla/geckodriver/releases/latest|]
+  req <- parseRequest url
+  manager <- liftIO newTlsManager
+  ExceptT $
+    handle (\(e :: HttpException) -> return $ Left [i|Error when requesting '#{url}': '#{e}'|])
+           (do
+               result <- httpLbs (req { requestHeaders = ("User-Agent", "foo") : (requestHeaders req) }) manager
+               case A.eitherDecode $ responseBody result of
+                 Right (A.Object (HM.lookup "tag_name" -> Just (A.String tag))) -> do
+                   let parts = T.splitOn "." $ T.drop 1 tag
+                   case parts of
+                     [tReadMay -> Just x, tReadMay -> Just y] -> return $ Right $ GeckoDriverVersion (x, y, 0)
+                     [tReadMay -> Just x, tReadMay -> Just y, tReadMay -> Just z] -> return $ Right $ GeckoDriverVersion (x, y, z)
+                     _ -> return $ Left [i|Unexpected geckodriver release tag: '#{tag}'|]
+                 val -> return $ Left [i|Failed to decode GitHub releases: '#{val}'|]
+           )
+
+
+getGeckoDriverDownloadUrl :: GeckoDriverVersion -> Platform -> T.Text
+getGeckoDriverDownloadUrl (GeckoDriverVersion (x, y, z)) Linux = [i|https://github.com/mozilla/geckodriver/releases/download/v#{x}.#{y}.#{z}/geckodriver-v#{x}.#{y}.#{z}-linux64.tar.gz|]
+getGeckoDriverDownloadUrl (GeckoDriverVersion (x, y, z)) OSX = [i|https://github.com/mozilla/geckodriver/releases/download/v#{x}.#{y}.#{z}/geckodriver-v#{x}.#{y}.#{z}-macos.tar.gz|]
+getGeckoDriverDownloadUrl (GeckoDriverVersion (x, y, z)) Windows = [i|https://github.com/mozilla/geckodriver/releases/download/v#{x}.#{y}.#{z}/geckodriver-v#{x}.#{y}.#{z}-win32.tar.gz|]
+
+-- * Util
+
+tReadMay = readMay . convert
diff --git a/src/Test/Sandwich/WebDriver/Internal/Capabilities.hs b/src/Test/Sandwich/WebDriver/Internal/Capabilities.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Sandwich/WebDriver/Internal/Capabilities.hs
@@ -0,0 +1,80 @@
+{-# LANGUAGE OverloadedLists #-}
+-- |
+
+module Test.Sandwich.WebDriver.Internal.Capabilities (
+  -- * Chrome
+  chromeCapabilities
+  , headlessChromeCapabilities
+
+  -- * Firefox
+  , firefoxCapabilities
+  , headlessFirefoxCapabilities
+  ) where
+
+import qualified Data.Aeson as A
+import Data.Default
+import qualified Data.HashMap.Strict as HM
+import qualified Data.Text as T
+import Test.WebDriver
+
+loggingPrefs :: A.Value
+loggingPrefs = A.object [("browser", "ALL")
+                        , ("client", "WARNING")
+                        , ("driver", "WARNING")
+                        , ("performance", "ALL")
+                        , ("server", "WARNING")
+                        ]
+
+-- * Chrome
+
+-- | Default capabilities for regular Chrome.
+-- Has the "browser" log level to "ALL" so that tests can collect browser logs.
+chromeCapabilities :: Capabilities
+chromeCapabilities =
+  def {browser=Chrome Nothing Nothing args [] chromePrefs
+      , additionalCaps=[("loggingPrefs", loggingPrefs)
+                       , ("goog:loggingPrefs", loggingPrefs)]
+      }
+  where args = ["--verbose"]
+
+-- | Default capabilities for headless Chrome.
+headlessChromeCapabilities :: Capabilities
+headlessChromeCapabilities =
+  def {browser=Chrome Nothing Nothing args [] chromePrefs
+      , additionalCaps=[("loggingPrefs", loggingPrefs)
+                       , ("goog:loggingPrefs", loggingPrefs)]
+      }
+  where args = ["--verbose", "--headless"]
+
+chromePrefs :: HM.HashMap T.Text A.Value
+chromePrefs = HM.fromList [
+  ("prefs", A.object [("profile.default_content_setting_values.automatic_downloads", A.Number 1)
+                     , ("profile.content_settings.exceptions.automatic_downloads.*.setting", A.Number 1)
+                     , ("download.prompt_for_download", A.Bool False)
+                     , ("download.directory_upgrade", A.Bool True)
+                     , ("download.default_directory", "/tmp")])
+  ]
+
+-- * Firefox
+
+-- | Default capabilities for regular Firefox.
+firefoxCapabilities :: Capabilities
+firefoxCapabilities = def { browser=ff }
+  where
+    ff = Firefox { ffProfile = Nothing
+                 , ffLogPref = LogAll
+                 , ffBinary = Nothing
+                 , ffAcceptInsecureCerts = Nothing
+                 }
+
+-- | Default capabilities for headless Firefox.
+headlessFirefoxCapabilities :: Capabilities
+headlessFirefoxCapabilities = def { browser=ff, additionalCaps=additionalCaps }
+  where
+    ff = Firefox { ffProfile = Nothing
+                 , ffLogPref = LogAll
+                 , ffBinary = Nothing
+                 , ffAcceptInsecureCerts = Nothing
+                 }
+
+    additionalCaps = [("moz:firefoxOptions", A.object [("args", A.Array ["-headless"])])]
diff --git a/src/Test/Sandwich/WebDriver/Internal/Ports.hs b/src/Test/Sandwich/WebDriver/Internal/Ports.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Sandwich/WebDriver/Internal/Ports.hs
@@ -0,0 +1,78 @@
+{-# LANGUAGE RankNTypes, MultiWayIf, ScopedTypeVariables, LambdaCase #-}
+
+module Test.Sandwich.WebDriver.Internal.Ports (
+  findFreePortOrException
+  ) where
+
+import Control.Exception
+import Control.Retry
+import Data.Maybe
+import Data.String.Interpolate
+import qualified Data.Text as T
+import Network.Socket
+import System.Random (randomRIO)
+import Test.Sandwich.WebDriver.Internal.Util
+
+firstUserPort :: PortNumber
+firstUserPort = 1024
+
+highestPort :: PortNumber
+highestPort = 65535
+
+-- |Find an unused port in a given range
+findFreePortInRange' :: RetryPolicy -> IO PortNumber -> IO (Maybe PortNumber)
+findFreePortInRange' policy getAcceptableCandidate = retrying policy (\_retryStatus result -> return $ isNothing result) (const findFreePortInRange'')
+  where
+    findFreePortInRange'' :: IO (Maybe PortNumber)
+    findFreePortInRange'' = do
+      candidate <- getAcceptableCandidate
+      catch (tryOpenAndClosePort candidate >> return (Just candidate)) (\(_ :: SomeException) -> return Nothing)
+      where
+        tryOpenAndClosePort :: PortNumber -> IO PortNumber
+        tryOpenAndClosePort port = do
+          sock <- socket AF_INET Stream 0
+          setSocketOption sock ReuseAddr 1
+          let hostAddress = tupleToHostAddress (127, 0, 0, 1)
+          bind sock (SockAddrInet port hostAddress)
+          close sock
+          return $ fromIntegral port
+
+findFreePortInRange :: IO PortNumber -> IO (Maybe PortNumber)
+findFreePortInRange = findFreePortInRange' (limitRetries 50)
+
+-- | Find an unused port in the ephemeral port range.
+-- See https://en.wikipedia.org/wiki/List_of_TCP_and_UDP_port_numbers
+-- This works without a timeout since there should always be a port in the somewhere;
+-- it might be advisable to wrap in a timeout anyway.
+findFreePort :: IO (Maybe PortNumber)
+findFreePort = findFreePortInRange getNonEphemeralCandidate
+
+findFreePortOrException :: IO PortNumber
+findFreePortOrException = findFreePort >>= \case
+  Just port -> return port
+  Nothing -> error "Couldn't find free port"
+
+-- * Util
+
+getNonEphemeralCandidate :: IO PortNumber
+getNonEphemeralCandidate = do
+  (ephemeralStart, ephemeralEnd) <- getEphemeralPortRange >>= \case
+    Left _ -> return (49152, 65535)
+    Right range -> return range
+
+  let numBelow = ephemeralStart - firstUserPort
+  let numAbove = highestPort - ephemeralEnd
+
+  u :: Double <- randomRIO (0, 1)
+
+  let useLowerRange = u < ((fromIntegral numBelow) / (fromIntegral numBelow + fromIntegral numAbove))
+
+  if | useLowerRange -> fromInteger <$> randomRIO (fromIntegral firstUserPort, fromIntegral ephemeralStart)
+     | otherwise -> fromInteger <$> randomRIO (fromIntegral ephemeralEnd, fromIntegral highestPort)
+
+getEphemeralPortRange :: IO (Either T.Text (PortNumber, PortNumber))
+getEphemeralPortRange = leftOnException' $ do
+  contents <- readFile "/proc/sys/net/ipv4/ip_local_port_range"
+  case fmap read (words contents) of
+    [p1, p2] -> return (p1, p2)
+    _ -> error [i|Unexpected contents: '#{contents}'|]
diff --git a/src/Test/Sandwich/WebDriver/Internal/Screenshots.hs b/src/Test/Sandwich/WebDriver/Internal/Screenshots.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Sandwich/WebDriver/Internal/Screenshots.hs
@@ -0,0 +1,27 @@
+{-# LANGUAGE RankNTypes, MultiWayIf, ScopedTypeVariables, CPP, QuasiQuotes, RecordWildCards #-}
+-- |
+
+module Test.Sandwich.WebDriver.Internal.Screenshots where
+
+import Control.Concurrent
+import Control.Exception.Lifted
+import Control.Monad
+import Control.Monad.IO.Class
+import qualified Data.Map as M
+import Data.String.Interpolate
+import qualified Data.Text as T
+import GHC.Stack
+import Network.HTTP.Client
+import System.FilePath
+import Test.Sandwich.WebDriver.Internal.Types
+import Test.WebDriver
+
+saveScreenshots :: (HasCallStack) => T.Text -> WebDriver -> FilePath -> IO ()
+saveScreenshots screenshotName (WebDriver {..}) resultsDir = do
+  -- For every session, and for every window, try to get a screenshot for the results dir
+  sessionMap <- readMVar wdSessionMap
+  forM_ (M.toList sessionMap) $ \(browser, sess) -> runWD sess $
+    handle (\(e :: HttpException) -> case e of
+               (HttpExceptionRequest _ content) -> liftIO $ putStrLn [i|HttpException when trying to take a screenshot: '#{content}'|]
+               e -> liftIO $ putStrLn [i|HttpException when trying to take a screenshot: '#{e}'|])
+           (saveScreenshot $ resultsDir </> [i|#{browser}_#{screenshotName}.png|])
diff --git a/src/Test/Sandwich/WebDriver/Internal/StartWebDriver.hs b/src/Test/Sandwich/WebDriver/Internal/StartWebDriver.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Sandwich/WebDriver/Internal/StartWebDriver.hs
@@ -0,0 +1,200 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE ViewPatterns #-}
+-- |
+
+module Test.Sandwich.WebDriver.Internal.StartWebDriver where
+
+
+import Control.Concurrent
+import Control.Monad
+import Control.Monad.Catch (MonadMask)
+import Control.Monad.IO.Class
+import Control.Monad.Logger
+import Control.Monad.Trans.Control (MonadBaseControl)
+import Control.Retry
+import qualified Data.Aeson as A
+import Data.Default
+import Data.Function
+import qualified Data.HashMap.Strict as HM
+import qualified Data.List as L
+import Data.Maybe
+import Data.String.Interpolate
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+import qualified Data.Vector as V
+import GHC.Stack
+import Lens.Micro
+import Lens.Micro.Aeson
+import System.Directory
+import System.FilePath
+import System.IO
+import System.Process
+import Test.Sandwich
+import Test.Sandwich.WebDriver.Internal.Binaries
+import Test.Sandwich.WebDriver.Internal.Ports
+import Test.Sandwich.WebDriver.Internal.StartWebDriver.Xvfb
+import Test.Sandwich.WebDriver.Internal.Types
+import Test.Sandwich.WebDriver.Internal.Util
+import qualified Test.WebDriver as W
+
+type Constraints m = (HasCallStack, MonadLogger m, MonadIO m, MonadBaseControl IO m, MonadMask m)
+
+-- | Spin up a Selenium WebDriver and create a WebDriver
+startWebDriver :: Constraints m => WdOptions -> FilePath -> m WebDriver
+startWebDriver wdOptions@(WdOptions {..}) runRoot = do
+  -- Create a unique name for this webdriver so the folder for its log output doesn't conflict with any others
+  webdriverName <- ("webdriver_" <>) <$> (liftIO makeUUID)
+
+  -- Directory to log everything for this webdriver
+  let webdriverRoot = runRoot </> (T.unpack webdriverName)
+  liftIO $ createDirectoryIfMissing True webdriverRoot
+
+  -- Get selenium and chromedriver
+  debug [i|Preparing to create the Selenium process|]
+  liftIO $ createDirectoryIfMissing True toolsRoot
+  seleniumPath <- obtainSelenium toolsRoot seleniumToUse >>= \case
+    Left err -> error [i|Failed to obtain selenium: '#{err}'|]
+    Right p -> return p
+  driverArgs <- case W.browser capabilities of
+    W.Firefox {} -> do
+      obtainGeckoDriver toolsRoot geckoDriverToUse >>= \case
+        Left err -> error [i|Failed to obtain geckodriver: '#{err}'|]
+        Right p -> return [[i|-Dwebdriver.gecko.driver=#{p}|]
+                          -- , [i|-Dwebdriver.gecko.logfile=#{webdriverRoot </> "geckodriver.log"}|]
+                          -- , [i|-Dwebdriver.gecko.verboseLogging=true|]
+                          ]
+    W.Chrome {} -> do
+      obtainChromeDriver toolsRoot chromeDriverToUse >>= \case
+        Left err -> error [i|Failed to obtain chromedriver: '#{err}'|]
+        Right p -> return [[i|-Dwebdriver.chrome.driver=#{p}|]
+                          , [i|-Dwebdriver.chrome.logfile=#{webdriverRoot </> "chromedriver.log"}|]
+                          , [i|-Dwebdriver.chrome.verboseLogging=true|]]
+    x -> error [i|Browser #{x} is not supported yet|]
+
+  debug [i|driverArgs: #{driverArgs}|]
+
+  (maybeXvfbSession, javaEnv) <- case runMode of
+    RunInXvfb (XvfbConfig {..}) -> do
+      (s, e) <- makeXvfbSession xvfbResolution xvfbStartFluxbox webdriverRoot
+      return (Just s, Just e)
+    _ -> return (Nothing, Nothing)
+
+  -- Retry up to 10 times
+  -- This is necessary because sometimes we get a race for the port we get from findFreePortOrException.
+  -- There doesn't seem to be any way to make Selenium choose its own port.
+  let policy = constantDelay 0 <> limitRetries 10
+  recoverAll policy $ \retryStatus -> do
+    when (rsIterNumber retryStatus > 0) $
+      warn [i|Trying again to start selenium server|]
+
+    -- Create a distinct process name
+    webdriverProcessName <- ("webdriver_process_" <>) <$> (liftIO makeUUID)
+    let webdriverProcessRoot = webdriverRoot </> T.unpack webdriverProcessName
+    liftIO $ createDirectoryIfMissing True webdriverProcessRoot
+    startWebDriver' wdOptions webdriverName webdriverProcessRoot seleniumPath driverArgs maybeXvfbSession javaEnv
+
+startWebDriver' wdOptions@(WdOptions {capabilities=capabilities', ..}) webdriverName webdriverRoot seleniumPath driverArgs maybeXvfbSession javaEnv = do
+  port <- liftIO findFreePortOrException
+  let wdCreateProcess = (proc "java" (driverArgs <> ["-jar", seleniumPath
+                                                    , "-port", show port])) { env = javaEnv }
+
+  -- Open output handles
+  let seleniumOutPath = webdriverRoot </> seleniumOutFileName
+  hout <- liftIO $ openFile seleniumOutPath AppendMode
+  let seleniumErrPath = webdriverRoot </> seleniumErrFileName
+  herr <- liftIO $ openFile seleniumErrPath AppendMode
+
+  -- Start the process and wait for it to be ready
+  debug [i|Starting the Selenium process|]
+  (_, _, _, p) <- liftIO $ createProcess $ wdCreateProcess {
+    std_in = Inherit
+    , std_out = UseHandle hout
+    , std_err = UseHandle herr
+    , create_group = True
+    }
+  -- Normally Selenium prints the ready message to stderr. However, when we're running under
+  -- XVFB the two streams get combined and sent to stdout; see
+  -- https://bugs.launchpad.net/ubuntu/+source/xorg-server/+bug/1059947
+  -- As a result, we poll both files
+  let readyMessage = "Selenium Server is up and running"
+  -- Retry every 60ms, for up to 60s before admitting defeat
+  let policy = constantDelay 60000 <> limitRetries 1000
+  success <- retrying policy (\_retryStatus result -> return (not result)) $ const $
+    (liftIO $ T.readFile seleniumErrPath) >>= \case
+      t | readyMessage `T.isInfixOf` t -> return True
+      _ -> (liftIO $ T.readFile seleniumOutPath) >>= \case
+        t | readyMessage `T.isInfixOf` t -> return True
+        _ -> return False
+  unless success $ liftIO $ do
+    interruptProcessGroupOf p >> waitForProcess p
+    error [i|Selenium server failed to start after 60 seconds|]
+
+  -- Make the WebDriver
+  WebDriver <$> pure (T.unpack webdriverName)
+            <*> pure (hout, herr, p, seleniumOutPath, seleniumErrPath, maybeXvfbSession)
+            <*> pure wdOptions
+            <*> liftIO (newMVar mempty)
+            <*> pure (def { W.wdPort = fromIntegral port
+                          , W.wdCapabilities = configureCapabilities capabilities' runMode
+                          , W.wdHTTPManager = httpManager
+                          , W.wdHTTPRetryCount = httpRetryCount
+                          })
+
+
+stopWebDriver :: Constraints m => WebDriver -> m ()
+stopWebDriver (WebDriver {wdWebDriver=(hout, herr, h, _, _, maybeXvfbSession)}) = do
+  _ <- liftIO (interruptProcessGroupOf h >> waitForProcess h)
+  liftIO $ hClose hout
+  liftIO $ hClose herr
+
+  whenJust maybeXvfbSession $ \(XvfbSession {..}) -> do
+    whenJust xvfbFluxboxProcess $ \p ->
+      liftIO (interruptProcessGroupOf p >> waitForProcess p)
+
+    liftIO (interruptProcessGroupOf xvfbProcess >> waitForProcess xvfbProcess)
+
+-- * Util
+
+seleniumOutFileName, seleniumErrFileName :: FilePath
+seleniumOutFileName = "stdout.txt"
+seleniumErrFileName = "stderr.txt"
+
+-- | Add headless configuration to the Chrome browser
+configureCapabilities caps@(W.Capabilities {W.browser=browser@(W.Chrome {..})}) (RunHeadless (HeadlessConfig {..})) = caps { W.browser = browser' }
+  where browser' = browser { W.chromeOptions = "--headless":resolution:chromeOptions }
+        resolution = [i|--window-size=#{w},#{h}|]
+        (w, h) = fromMaybe (1920, 1080) headlessResolution
+
+-- | Add headless configuration to the Firefox capabilities
+configureCapabilities caps@(W.Capabilities {W.browser=(W.Firefox {..}), W.additionalCaps=ac}) (RunHeadless (HeadlessConfig {..})) = caps { W.additionalCaps = additionalCaps }
+  where
+    additionalCaps = case L.findIndex (\x -> fst x == "moz:firefoxOptions") ac of
+      Nothing -> ("moz:firefoxOptions", A.object [("args", A.Array ["-headless"])]) : ac
+      Just i -> let ffOptions' = (snd $ ac !! i)
+                      & ensureKeyExists "args" (A.Array [])
+                      & ((key "args" . _Array) %~ addHeadlessArg) in
+        L.nubBy (\x y -> fst x == fst y) (("moz:firefoxOptions", ffOptions') : ac)
+
+    ensureKeyExists :: T.Text -> A.Value -> A.Value -> A.Value
+    ensureKeyExists key _ val@(A.Object (HM.lookup key -> Just _)) = val
+    ensureKeyExists key defaultVal (A.Object m@(HM.lookup key -> Nothing)) = A.Object (HM.insert key defaultVal m)
+    ensureKeyExists _ _ _ = error "Expected Object in ensureKeyExists"
+
+    addHeadlessArg :: V.Vector A.Value -> V.Vector A.Value
+    addHeadlessArg xs | (A.String "-headless") `V.elem` xs = xs
+    addHeadlessArg xs = (A.String "-headless") `V.cons` xs
+
+configureCapabilities browser (RunHeadless {}) = error [i|Headless mode not yet supported for browser '#{browser}'|]
+configureCapabilities browser _ = browser
diff --git a/src/Test/Sandwich/WebDriver/Internal/StartWebDriver/Xvfb.hs b/src/Test/Sandwich/WebDriver/Internal/StartWebDriver/Xvfb.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Sandwich/WebDriver/Internal/StartWebDriver/Xvfb.hs
@@ -0,0 +1,129 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
+-- |
+
+module Test.Sandwich.WebDriver.Internal.StartWebDriver.Xvfb (
+  makeXvfbSession
+  ) where
+
+import Control.Exception
+import Control.Monad.Catch (MonadMask)
+import Control.Monad.IO.Class
+import Control.Monad.Logger
+import Control.Monad.Trans.Control (MonadBaseControl)
+import Control.Retry
+import qualified Data.List as L
+import Data.Maybe
+import Data.String.Interpolate
+import GHC.Stack
+import Safe
+import System.Directory
+import System.Environment
+import System.IO.Temp
+import System.Process
+import Test.Sandwich
+import Test.Sandwich.WebDriver.Internal.Types
+
+
+#ifdef linux_HOST_OS
+import System.Posix.IO as Posix
+import System.Posix.Types
+#endif
+
+
+type Constraints m = (HasCallStack, MonadLogger m, MonadIO m, MonadBaseControl IO m, MonadMask m)
+
+
+makeXvfbSession :: Constraints m => Maybe (Int, Int) -> Bool -> FilePath -> m (XvfbSession, [(String, String)])
+makeXvfbSession xvfbResolution xvfbStartFluxbox webdriverRoot = do
+  let (w, h) = fromMaybe (1920, 1080) xvfbResolution
+  liftIO $ createDirectoryIfMissing True webdriverRoot
+
+  let policy = constantDelay 10000 <> limitRetries 1000
+  (serverNum :: Int, p, authFile, displayNum) <- recoverAll policy $ \_ -> do
+    withTempFile webdriverRoot "x11_server_num" $ \path tmpHandle -> do
+      fd <- liftIO $ handleToFd tmpHandle
+      (serverNum, p, authFile) <- createXvfbSession webdriverRoot w h fd
+
+      debug [i|Trying to determine display number for auth file '#{authFile}', using '#{path}'|]
+
+      displayNum <-
+        recoverAll policy $ \_ ->
+          (liftIO $ readFile path) >>= \contents -> case readMay contents of -- hGetContents readHandle
+            Nothing -> liftIO $ throwIO $ userError [i|Couldn't determine X11 screen to use. Got data: '#{contents}'. Path was '#{path}'|]
+            Just (x :: Int) -> return x
+
+      return (serverNum, p, authFile, displayNum)
+
+  fluxboxProcess <- if xvfbStartFluxbox then Just <$> (startFluxBoxOnDisplay webdriverRoot displayNum) else return Nothing
+
+  let xvfbSession = XvfbSession {
+        xvfbDisplayNum = displayNum
+        , xvfbXauthority = authFile
+        , xvfbDimensions = (w, h)
+        , xvfbProcess = p
+        , xvfbFluxboxProcess = fluxboxProcess
+        }
+
+  -- TODO: allow verbose logging to be controlled with an option:
+  env' <- liftIO getEnvironment
+  let env = L.nubBy (\x y -> fst x == fst y) $ [("DISPLAY", ":" <> show serverNum)
+                                               , ("XAUTHORITY", xvfbXauthority xvfbSession)] <> env'
+  return (xvfbSession, env)
+
+
+createXvfbSession :: Constraints m => FilePath -> Int -> Int -> Fd -> m (Int, ProcessHandle, FilePath)
+createXvfbSession webdriverRoot w h (Fd fd) = do
+  serverNum <- liftIO findFreeServerNum
+
+  -- Start the Xvfb session
+  authFile <- liftIO $ writeTempFile webdriverRoot ".Xauthority" ""
+  p <- createProcessWithLogging $ (proc "Xvfb" [":" <> show serverNum
+                                               , "-screen", "0", [i|#{w}x#{h}x24|]
+                                               , "-displayfd", [i|#{fd}|]
+                                               , "-auth", authFile
+                                               ]) { cwd = Just webdriverRoot
+                                                  , create_group = True }
+
+  return (serverNum, p, authFile)
+
+
+findFreeServerNum :: IO Int
+findFreeServerNum = findFreeServerNum' 99
+  where
+    findFreeServerNum' :: Int -> IO Int
+    findFreeServerNum' candidate = do
+      doesPathExist [i|/tmp/.X11-unix/X#{candidate}|] >>= \case
+        True -> findFreeServerNum' (candidate + 1)
+        False -> return candidate
+
+
+startFluxBoxOnDisplay :: Constraints m => FilePath -> Int -> m ProcessHandle
+startFluxBoxOnDisplay webdriverRoot x = do
+  logPath <- liftIO $ writeTempFile webdriverRoot "fluxbox.log" ""
+
+  debug [i|Starting fluxbox on logPath '#{logPath}'|]
+
+  let args = ["-display", ":" <> show x
+             , "-log", logPath]
+
+  (_, _, _, p) <- liftIO $ createProcess $ (proc "fluxbox" args) {
+    cwd = Just webdriverRoot
+    , create_group = True
+    , std_out = CreatePipe
+    , std_err = CreatePipe
+    }
+
+  -- TODO: confirm fluxbox started successfully
+
+  return p
diff --git a/src/Test/Sandwich/WebDriver/Internal/Types.hs b/src/Test/Sandwich/WebDriver/Internal/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Sandwich/WebDriver/Internal/Types.hs
@@ -0,0 +1,235 @@
+{-# LANGUAGE TypeFamilies, InstanceSigs, RecordWildCards, ScopedTypeVariables, QuasiQuotes, Rank2Types, NamedFieldPuns, DataKinds, ConstraintKinds #-}
+
+module Test.Sandwich.WebDriver.Internal.Types where
+
+import Control.Concurrent.MVar
+import Control.Exception
+import Data.Default
+import Data.IORef
+import qualified Data.Map as M
+import Data.String.Interpolate
+import qualified Data.Text as T
+import Network.HTTP.Client (Manager)
+import System.IO
+import System.Process
+import Test.Sandwich
+import qualified Test.WebDriver as W
+import qualified Test.WebDriver.Class as W
+import qualified Test.WebDriver.Session as W
+
+-- | 'Session' is just a 'String' name
+type Session = String
+
+-- * Labels
+webdriver = Label :: Label "webdriver" WebDriver
+webdriverSession = Label :: Label "webdriverSession" WebDriverSession
+
+type WebDriverContext context wd = (HasLabel context "webdriver" WebDriver, W.WebDriver (ExampleT context wd))
+
+-- TODO: remove
+class HasWebDriver a where
+  getWebDriver :: a -> WebDriver
+
+instance HasWebDriver WebDriver where
+  getWebDriver = id
+
+type ToolsRoot = FilePath
+
+data WhenToSave = Always | OnException | Never deriving (Show, Eq)
+
+-- | Headless and Xvfb modes are useful because they allow you to run tests in the background, without popping up browser windows.
+-- This is useful for development or for running on a CI server, and is also more reproducible since the screen resolution can be fixed.
+-- In addition, Xvfb mode allows videos to be recorded of tests.
+data RunMode = Normal
+             -- ^ Normal Selenium behavior; will pop up a web browser.
+             | RunHeadless HeadlessConfig
+             -- ^ Run with a headless browser. Supports screenshots but videos will be black.
+             | RunInXvfb XvfbConfig
+             -- ^ Run inside <https://en.wikipedia.org/wiki/Xvfb Xvfb> so that tests run in their own X11 display.
+             -- xvfb-run script must be installed and on the PATH.
+
+data WdOptions = WdOptions {
+  toolsRoot :: ToolsRoot
+  -- ^ Folder where any necessary binaries (chromedriver, Selenium, etc.) will be downloaded if needed. Required.
+
+  , capabilities :: W.Capabilities
+  -- ^ The WebDriver capabilities to use
+
+  , saveSeleniumMessageHistory :: WhenToSave
+  -- ^ When to save a record of Selenium requests and responses
+
+  , saveLogSettings :: SaveLogSettings
+  -- ^ When to save a record of Selenium requests and responses
+
+  , seleniumToUse :: SeleniumToUse
+  -- ^ Which Selenium server JAR file to use
+
+  , chromeDriverToUse :: ChromeDriverToUse
+  -- ^ Which chromedriver executable to use
+
+  , geckoDriverToUse :: GeckoDriverToUse
+  -- ^ Which geckodriver executable to use
+
+  , runMode :: RunMode
+  -- ^ How to handle opening the browser (in a popup window, headless, etc.)
+
+  , httpManager :: Maybe Manager
+  -- ^ HTTP manager for making requests to Selenium. If not provided, one will be created for each session.
+
+  , httpRetryCount :: Int
+  -- ^ Number of times to retry an HTTP request if it times out
+  }
+
+-- | How to obtain the Selenium server JAR file.
+data SeleniumToUse =
+  DownloadSeleniumFrom String
+  -- ^ Download selenium from the given URL to the 'toolsRoot'
+  | DownloadSeleniumDefault
+  -- ^ Download selenium from a default location to the 'toolsRoot'
+  | UseSeleniumAt FilePath
+  -- ^ Use the JAR file at the given path
+
+-- | How to obtain the chromedriver binary.
+data ChromeDriverToUse =
+  DownloadChromeDriverFrom String
+  -- ^ Download chromedriver from the given URL to the 'toolsRoot'
+  | DownloadChromeDriverVersion ChromeDriverVersion
+  -- ^ Download the given chromedriver version to the 'toolsRoot'
+  | DownloadChromeDriverAutodetect
+  -- ^ Autodetect chromedriver to use based on the Chrome version and download it to the 'toolsRoot'
+  | UseChromeDriverAt FilePath
+  -- ^ Use the chromedriver at the given path
+
+-- | How to obtain the geckodriver binary.
+data GeckoDriverToUse =
+  DownloadGeckoDriverFrom String
+  -- ^ Download geckodriver from the given URL to the 'toolsRoot'
+  | DownloadGeckoDriverVersion GeckoDriverVersion
+  -- ^ Download the given geckodriver version to the 'toolsRoot'
+  | DownloadGeckoDriverAutodetect
+  -- ^ Autodetect geckodriver to use based on the Gecko version and download it to the 'toolsRoot'
+  | UseGeckoDriverAt FilePath
+  -- ^ Use the geckodriver at the given path
+
+newtype ChromeVersion = ChromeVersion (Int, Int, Int, Int) deriving Show
+newtype ChromeDriverVersion = ChromeDriverVersion (Int, Int, Int, Int) deriving Show
+
+newtype FirefoxVersion = FirefoxVersion (Int, Int, Int) deriving Show
+newtype GeckoDriverVersion = GeckoDriverVersion (Int, Int, Int) deriving Show
+
+data HeadlessConfig = HeadlessConfig {
+  headlessResolution :: Maybe (Int, Int)
+  -- ^ Resolution for the headless browser. Defaults to (1920, 1080)
+  }
+
+defaultHeadlessConfig = HeadlessConfig Nothing
+
+data XvfbConfig = XvfbConfig {
+  xvfbResolution :: Maybe (Int, Int)
+  -- ^ Resolution for the virtual screen. Defaults to (1920, 1080)
+
+  , xvfbStartFluxbox :: Bool
+  -- ^ Whether to start fluxbox window manager to go with the Xvfb session. fluxbox must be on the path
+  }
+
+defaultXvfbConfig = XvfbConfig Nothing False
+
+
+-- | The default 'WdOptions' object.
+-- You should start with this and modify it using the accessors.
+defaultWdOptions :: FilePath -> WdOptions
+defaultWdOptions toolsRoot = WdOptions {
+  toolsRoot = toolsRoot
+  , capabilities = def
+  , saveSeleniumMessageHistory = OnException
+  , saveLogSettings = mempty
+  , seleniumToUse = DownloadSeleniumDefault
+  , chromeDriverToUse = DownloadChromeDriverAutodetect
+  , geckoDriverToUse = DownloadGeckoDriverAutodetect
+  , runMode = Normal
+  , httpManager = Nothing
+  , httpRetryCount = 0
+  }
+
+type SaveLogSettings = M.Map W.LogType (W.LogEntry -> Bool, W.LogEntry -> T.Text, W.LogEntry -> Bool)
+
+data WebDriver = WebDriver { wdName :: String
+                           , wdWebDriver :: (Handle, Handle, ProcessHandle, FilePath, FilePath, Maybe XvfbSession)
+                           , wdOptions :: WdOptions
+                           , wdSessionMap :: MVar (M.Map Session W.WDSession)
+                           , wdConfig :: W.WDConfig }
+
+data InvalidLogsException = InvalidLogsException [W.LogEntry]
+  deriving (Show)
+
+instance Exception InvalidLogsException
+
+data XvfbSession = XvfbSession { xvfbDisplayNum :: Int
+                               , xvfbXauthority :: FilePath
+                               , xvfbDimensions :: (Int, Int)
+                               , xvfbProcess :: ProcessHandle
+                               , xvfbFluxboxProcess :: Maybe ProcessHandle }
+
+type WebDriverSession = (Session, IORef W.WDSession)
+
+-- | Get the 'WdOptions' associated with the 'WebDriver'
+getWdOptions :: WebDriver -> WdOptions
+getWdOptions = wdOptions
+
+-- | Get the X11 display number associated with the 'WebDriver'.
+-- Only present if running in 'RunInXvfb' mode.
+getDisplayNumber :: WebDriver -> Maybe Int
+getDisplayNumber (WebDriver {wdWebDriver=(_, _, _, _, _, Just (XvfbSession {xvfbDisplayNum}))}) = Just xvfbDisplayNum
+getDisplayNumber _ = Nothing
+
+-- | Get the Xvfb session associated with the 'WebDriver', if present
+getXvfbSession :: WebDriver -> Maybe XvfbSession
+getXvfbSession (WebDriver {wdWebDriver=(_, _, _, _, _, Just sess)}) = Just sess
+getXvfbSession _ = Nothing
+
+-- | Get the name of the 'WebDriver'
+getWebDriverName :: WebDriver -> String
+getWebDriverName (WebDriver {wdName}) = wdName
+
+instance Show XvfbSession where
+  show (XvfbSession {xvfbDisplayNum}) = [i|<XVFB session with server num #{xvfbDisplayNum}>|]
+
+-- * Video stuff
+
+fastX11VideoOptions = ["-an"
+                      , "-r", "30"
+                      , "-vcodec"
+                      , "libxvid"
+                      , "-qscale:v", "1"
+                      , "-threads", "0"]
+
+qualityX11VideoOptions = ["-an"
+                         , "-r", "30"
+                         , "-vcodec", "libx264"
+                         , "-preset", "veryslow"
+                         , "-crf", "0"
+                         , "-threads", "0"]
+
+defaultAvfoundationOptions = ["-r", "30"
+                             , "-an"
+                             , "-vcodec", "libxvid"
+                             , "-qscale:v", "1"
+                             , "-threads", "0"]
+
+defaultGdigrabOptions = ["-framerate", "30"]
+
+data VideoSettings = VideoSettings { x11grabOptions :: [String]
+                                   -- ^ Arguments to x11grab, used with Linux.
+                                   , avfoundationOptions :: [String]
+                                   -- ^ Arguments to avfoundation, used with OS X.
+                                   , gdigrabOptions :: [String]
+                                   -- ^ Arguments to gdigrab, used with Windows.
+                                   , hideMouseWhenRecording :: Bool
+                                   -- ^ Hide the mouse while recording video. Linux and Windows only.
+                                   }
+
+instance Default VideoSettings where
+  def = VideoSettings { x11grabOptions = fastX11VideoOptions
+                      , avfoundationOptions = defaultAvfoundationOptions
+                      , gdigrabOptions = defaultGdigrabOptions
+                      , hideMouseWhenRecording = False }
diff --git a/src/Test/Sandwich/WebDriver/Internal/Util.hs b/src/Test/Sandwich/WebDriver/Internal/Util.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Sandwich/WebDriver/Internal/Util.hs
@@ -0,0 +1,61 @@
+{-# LANGUAGE CPP, QuasiQuotes, ScopedTypeVariables, NamedFieldPuns, FlexibleContexts #-}
+
+module Test.Sandwich.WebDriver.Internal.Util where
+
+import Control.Exception
+import qualified Control.Exception.Lifted as E
+import Control.Monad
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Control (MonadBaseControl)
+import Data.Convertible
+import Data.String.Interpolate
+import qualified Data.Text as T
+import System.Directory
+import System.Process
+import qualified System.Random as R
+
+-- * Truncating log files
+
+moveAndTruncate :: FilePath -> String -> IO ()
+moveAndTruncate from to = do
+  exists <- doesFileExist from
+  when exists $ do
+    copyFile from to
+    tryTruncateFile from
+
+  where
+    tryTruncateFile :: FilePath -> IO ()
+    tryTruncateFile path = E.catch (truncateFile path)
+                                   (\(e :: E.SomeException) -> putStrLn [i|Failed to truncate file #{path}: #{e}|])
+
+    truncateFile :: FilePath -> IO ()
+#ifdef mingw32_HOST_OS
+    truncateFile path = withFile path WriteMode $ flip hPutStr "\n" -- Not exactly truncation, but close enough?
+#else
+    truncateFile path = void $ readCreateProcess (shell [i|> #{path}|]) ""
+#endif
+
+-- * Exceptions
+
+leftOnException :: (MonadIO m, MonadBaseControl IO m) => m (Either T.Text a) -> m (Either T.Text a)
+leftOnException = E.handle (\(e :: SomeException) -> return $ Left $ convert $ show e)
+
+leftOnException' :: (MonadIO m, MonadBaseControl IO m) => m a -> m (Either T.Text a)
+leftOnException' action = E.catch (Right <$> action) (\(e :: SomeException) -> return $ Left $ convert $ show e)
+
+-- * Util
+
+whenJust :: (Monad m) => Maybe a -> (a -> m b) -> m ()
+whenJust Nothing _ = return ()
+whenJust (Just x) action = void $ action x
+
+whenLeft :: (Monad m) => Either a b -> (a -> m ()) -> m ()
+whenLeft (Left x) action = action x
+whenLeft (Right _) _ = return ()
+
+whenRight :: (Monad m) => Either a b -> (b -> m ()) -> m ()
+whenRight (Left _) _ = return ()
+whenRight (Right x) action = action x
+
+makeUUID :: IO T.Text
+makeUUID = (convert . take 10 . R.randomRs ('a','z')) <$> R.newStdGen
diff --git a/src/Test/Sandwich/WebDriver/Internal/Video.hs b/src/Test/Sandwich/WebDriver/Internal/Video.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Sandwich/WebDriver/Internal/Video.hs
@@ -0,0 +1,63 @@
+{-# LANGUAGE CPP, QuasiQuotes, ScopedTypeVariables, FlexibleContexts, OverloadedStrings, NamedFieldPuns, ViewPatterns #-}
+-- |
+
+module Test.Sandwich.WebDriver.Internal.Video where
+
+import Control.Monad.IO.Class
+import Data.Maybe
+import Data.String.Interpolate
+import System.Environment
+import System.Process
+import Test.Sandwich.WebDriver.Internal.Types
+
+#ifdef darwin_HOST_OS
+import Safe
+#endif
+
+
+getVideoArgs path (width, height, x, y) (VideoSettings {..}) maybeXvfbSession = do
+#ifdef linux_HOST_OS
+  displayNum <- case maybeXvfbSession of
+    Nothing -> fromMaybe "" <$> (liftIO $ lookupEnv "DISPLAY")
+    Just (XvfbSession {xvfbDisplayNum}) -> return $ ":" <> show xvfbDisplayNum
+
+  let videoPath = [i|#{path}.avi|]
+  let env' = [("DISPLAY", displayNum)]
+  let env = case maybeXvfbSession of
+       Nothing -> Just env'
+       Just (XvfbSession {xvfbXauthority}) -> Just (("XAUTHORITY", xvfbXauthority) : env')
+  let cmd = ["-draw_mouse", (if hideMouseWhenRecording then "0" else "1")
+            , "-y"
+            , "-nostdin"
+            , "-f", "x11grab"
+            , "-s", [i|#{width}x#{height}|]
+            , "-i", [i|#{displayNum}.0+#{x},#{y}|]]
+            ++ x11grabOptions
+            ++ [videoPath]
+  return ((proc "ffmpeg" cmd) { env = env })
+#endif
+
+#ifdef darwin_HOST_OS
+  maybeScreenNumber <- liftIO getMacScreenNumber
+  let videoPath = [i|#{path}.avi|]
+  let cmd = case maybeScreenNumber of
+    Just screenNumber -> ["-y"
+                         , "-nostdin"
+                         , "-f", "avfoundation"
+                         , "-i", [i|#{screenNumber}|]]
+                         ++ avfoundationOptions
+                         ++ [videoPath]
+    Nothing -> error [i|Not launching ffmpeg since OS X screen number couldn't be determined.|]
+  return ((proc "ffmpeg" cmds) { env = Nothing })
+#endif
+
+#ifdef mingw32_HOST_OS
+  let videoPath = [i|#{path}.mkv|]
+  let cmd = ["-f", "gdigrab"
+            , "-nostdin"
+            , "-draw_mouse", (if hideMouseWhenRecording then "0" else "1")
+            , "-i", "desktop"]
+            ++ gdigrabOptions
+            ++ [videoPath]
+  return ((proc "ffmpeg.exe" cmd) { env = Nothing })
+#endif
diff --git a/src/Test/Sandwich/WebDriver/Types.hs b/src/Test/Sandwich/WebDriver/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Sandwich/WebDriver/Types.hs
@@ -0,0 +1,67 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE MonoLocalBinds #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Test.Sandwich.WebDriver.Types (
+  ExampleWithWebDriver
+  , HasWebDriverContext
+  , HasWebDriverSessionContext
+  , ContextWithSession
+
+  , hoistExample
+
+  , webdriver
+
+  -- * Constraint synonyms
+  , BaseMonad
+  , BaseMonadContext
+  , WebDriverMonad
+  , WebDriverSessionMonad
+  ) where
+
+import Control.Exception.Safe as ES
+import Control.Monad.IO.Class
+import Control.Monad.Reader
+import Control.Monad.Trans.Control (MonadBaseControl)
+import Data.IORef
+import GHC.Stack
+import Test.Sandwich
+import Test.Sandwich.Internal
+import Test.Sandwich.WebDriver.Internal.Types
+import qualified Test.WebDriver.Class as W
+import qualified Test.WebDriver.Internal as WI
+import qualified Test.WebDriver.Session as W
+
+
+type ContextWithSession context = LabelValue "webdriverSession" WebDriverSession :> context
+
+instance (MonadIO m, HasLabel context "webdriverSession" WebDriverSession) => W.WDSessionState (ExampleT context m) where
+  getSession = do
+    (_, sessVar) <- getContext webdriverSession
+    liftIO $ readIORef sessVar
+  putSession sess = do
+    (_, sessVar) <- getContext webdriverSession
+    liftIO $ writeIORef sessVar sess
+
+-- Implementation copied from that of the WD monad implementation
+instance (MonadIO m, MonadThrow m, HasLabel context "webdriverSession" WebDriverSession, MonadBaseControl IO m) => W.WebDriver (ExampleT context m) where
+  doCommand method path args = WI.mkRequest method path args
+    >>= WI.sendHTTPRequest
+    >>= either throwIO return
+    >>= WI.getJSONResult
+    >>= either throwIO return
+
+type HasWebDriverContext context = HasLabel context "webdriver" WebDriver
+type HasWebDriverSessionContext context = HasLabel context "webdriverSession" WebDriverSession
+type ExampleWithWebDriver context wd = (W.WDSessionState (ExampleT context wd), W.WebDriver wd)
+
+hoistExample :: ExampleT context IO a -> ExampleT (ContextWithSession context) IO a
+hoistExample (ExampleT r) = ExampleT $ transformContext r
+  where transformContext = withReaderT (\(_ :> ctx) -> ctx)
+
+type WebDriverMonad m context = (HasCallStack, HasLabel context "webdriver" WebDriver, MonadIO m, MonadBaseControl IO m)
+type WebDriverSessionMonad m context = (WebDriverMonad m context, MonadReader context m, HasLabel context "webdriverSession" WebDriverSession)
+type BaseMonad m = (HasCallStack, MonadIO m, MonadCatch m, MonadBaseControl IO m, MonadMask m)
+type BaseMonadContext m context = (BaseMonad m, HasBaseContext context)
diff --git a/src/Test/Sandwich/WebDriver/Video.hs b/src/Test/Sandwich/WebDriver/Video.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Sandwich/WebDriver/Video.hs
@@ -0,0 +1,82 @@
+{-# LANGUAGE CPP, QuasiQuotes, ScopedTypeVariables, FlexibleContexts, OverloadedStrings, NamedFieldPuns, ViewPatterns #-}
+
+module Test.Sandwich.WebDriver.Video (
+  startVideoRecording
+  , endVideoRecording
+
+  , startFullScreenVideoRecording
+  , startBrowserVideoRecording
+  ) where
+
+import Control.Exception.Safe
+import Control.Monad.IO.Class
+import Control.Monad.Logger hiding (logError)
+import Control.Monad.Reader
+import Control.Monad.Trans.Control (MonadBaseControl)
+import Data.String.Interpolate
+import System.Exit
+import System.FilePath
+import System.IO
+import System.Process
+import Test.Sandwich
+import Test.Sandwich.WebDriver
+import Test.Sandwich.WebDriver.Internal.Types
+import Test.Sandwich.WebDriver.Internal.Video
+import Test.Sandwich.WebDriver.Windows
+import Test.WebDriver.Class as W
+import Test.WebDriver.Commands
+
+
+startFullScreenVideoRecording :: (MonadIO m, MonadReader context m, MonadLogger m, HasWebDriverContext context, MonadBaseControl IO m, MonadMask m) =>
+  FilePath -> VideoSettings -> Bool -> m ProcessHandle
+startFullScreenVideoRecording path videoSettings logToDisk = do
+  sess <- getContext webdriver
+  let maybeXvfbSession = getXvfbSession sess
+  (width, height) <- case maybeXvfbSession of
+    Just (XvfbSession {xvfbDimensions}) -> return xvfbDimensions
+    Nothing -> do
+      (_x, _y, w, h) <- getScreenResolution sess
+      return (fromIntegral w, fromIntegral h)
+  startVideoRecording path (fromIntegral width, fromIntegral height, 0, 0) videoSettings logToDisk
+
+startBrowserVideoRecording :: (MonadIO m, MonadThrow m, MonadReader context m, MonadLogger m, HasWebDriverContext context, HasWebDriverSessionContext context, MonadBaseControl IO m, W.WebDriver m) =>
+  FilePath -> VideoSettings -> Bool -> m ProcessHandle
+startBrowserVideoRecording path videoSettings logToDisk = do
+  (x, y) <- getWindowPos
+  (w, h) <- getWindowSize
+  startVideoRecording path (w, h, x, y) videoSettings logToDisk
+
+startVideoRecording :: (MonadIO m, MonadReader context m, MonadLogger m, HasWebDriverContext context, MonadBaseControl IO m) =>
+  FilePath -> (Word, Word, Int, Int) -> VideoSettings -> Bool -> m ProcessHandle
+startVideoRecording path (width, height, x, y) vs logToDisk = do
+  sess <- getContext webdriver
+  let maybeXvfbSession = getXvfbSession sess
+
+  cp' <- liftIO $ getVideoArgs path (width, height, x, y) vs maybeXvfbSession
+  let cp = cp' { create_group = True }
+
+  case cmdspec cp of
+    ShellCommand s -> debug [i|ffmpeg command: #{s}|]
+    RawCommand p args -> debug [i|ffmpeg command: #{p} #{unwords args}|]
+
+  case logToDisk of
+    False -> createProcessWithLogging cp
+    True -> do
+      liftIO $ bracket (openFile (path <.> "stdout" <.> "log") AppendMode) hClose $ \hout ->
+        bracket (openFile (path <.> "stderr" <.> "log") AppendMode) hClose $ \herr -> do
+          (_, _, _, p) <- createProcess (cp { std_out = UseHandle hout, std_err = UseHandle herr })
+          return p
+
+endVideoRecording :: (MonadIO m, MonadLogger m, MonadCatch m) => ProcessHandle -> m ()
+endVideoRecording p = do
+  catchAny (liftIO $ interruptProcessGroupOf p)
+           (\e -> logError [i|Exception in interruptProcessGroupOf in endVideoRecording: #{e}|])
+
+  liftIO (waitForProcess p) >>= \case
+    ExitSuccess -> return ()
+
+    -- ffmpeg seems to exit with code 255 when exiting in response to a signal
+    -- https://github.com/FFmpeg/FFmpeg/blob/d182d8f10cf69c59ef9c21df4b06e5478df063ef/fftools/ffmpeg.c#L4890
+    ExitFailure 255 -> return ()
+
+    ExitFailure n -> debug [i|ffmpeg exited with unexpected exit code #{n}'|]
diff --git a/src/Test/Sandwich/WebDriver/Windows.hs b/src/Test/Sandwich/WebDriver/Windows.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Sandwich/WebDriver/Windows.hs
@@ -0,0 +1,84 @@
+{-# LANGUAGE QuasiQuotes #-}
+-- | Functions for manipulating browser windows
+
+module Test.Sandwich.WebDriver.Windows (
+  setWindowLeftSide
+  , setWindowRightSide
+  , setWindowFullScreen
+
+  , getScreenResolution
+  ) where
+
+import Control.Exception.Safe
+import Control.Monad.IO.Class
+import Control.Monad.Logger (MonadLogger)
+import Control.Monad.Reader
+import Data.Bits as B
+import Data.Maybe
+import Data.String.Interpolate
+import GHC.Stack
+import qualified Graphics.X11.Xinerama as X
+import qualified Graphics.X11.Xlib.Display as X
+import Safe
+import Test.Sandwich
+import Test.Sandwich.WebDriver.Internal.Types
+import Test.WebDriver
+import qualified Test.WebDriver.Class as W
+
+
+setWindowLeftSide :: (HasCallStack, MonadIO wd, WebDriverContext context wd, MonadReader context wd, W.WebDriver wd, MonadLogger wd, MonadMask wd) => wd ()
+setWindowLeftSide = do
+  sess <- getContext webdriver
+  (x, y, width, height) <- case runMode $ wdOptions sess of
+    RunHeadless (HeadlessConfig {..}) -> return (0, 0, w, h)
+      where (w, h) = fromMaybe (1920, 1080) headlessResolution
+    _ -> getScreenResolutionX11 sess
+  setWindowPos (x + 0, y + 0)
+  setWindowSize (fromIntegral $ B.shift width (-1), fromIntegral height)
+
+setWindowRightSide :: (HasCallStack, MonadIO wd, WebDriverContext context wd, MonadReader context wd, W.WebDriver wd, MonadLogger wd, MonadMask wd) => wd ()
+setWindowRightSide = do
+  sess <- getContext webdriver
+  (x, y, width, height) <- case runMode $ wdOptions sess of
+    RunHeadless (HeadlessConfig {..}) -> return (0, 0, w, h)
+      where (w, h) = fromMaybe (1920, 1080) headlessResolution
+    _ -> getScreenResolutionX11 sess
+  let pos = (x + (fromIntegral $ B.shift width (-1)), y + 0)
+  setWindowPos pos
+  setWindowSize (fromIntegral $ B.shift width (-1), fromIntegral height)
+
+setWindowFullScreen :: (HasCallStack, MonadIO wd, WebDriverContext context wd, MonadReader context wd, W.WebDriver wd, MonadLogger wd, MonadMask wd) => wd ()
+setWindowFullScreen = do
+  sess <- getContext webdriver
+  (x, y, width, height) <- case runMode $ wdOptions sess of
+    RunHeadless (HeadlessConfig {..}) -> return (0, 0, w, h)
+      where (w, h) = fromMaybe (1920, 1080) headlessResolution
+    _ -> getScreenResolutionX11 sess
+  setWindowPos (x + 0, y + 0)
+  setWindowSize (fromIntegral width, fromIntegral height)
+
+-- * Getting screen dimensions and resolution
+
+getScreenResolution :: (HasCallStack, MonadIO m, MonadMask m, MonadLogger m) => WebDriver -> m (Int, Int, Int, Int)
+getScreenResolution = getScreenResolutionX11
+
+-- * Internal
+
+getScreenResolutionX11 :: (HasCallStack, MonadIO m, MonadMask m, MonadLogger m) => WebDriver -> m (Int, Int, Int, Int)
+getScreenResolutionX11 (WebDriver {wdWebDriver=(_, _, _, _, _, maybeXvfbSession)}) = case maybeXvfbSession of
+    Nothing -> getScreenResolutionX11' ":0" 0
+    Just (XvfbSession {..}) -> getScreenResolutionX11' (":" <> show xvfbDisplayNum) 0
+
+getScreenResolutionX11' :: (HasCallStack, MonadIO m, MonadMask m, MonadLogger m) => String -> Int -> m (Int, Int, Int, Int)
+getScreenResolutionX11' displayString screenNumber = do
+  bracket (liftIO $ X.openDisplay displayString) (liftIO . X.closeDisplay) $ \display -> do
+    liftIO (X.xineramaQueryScreens display) >>= \case
+      Nothing -> do
+        -- TODO: this happens in CI when running under Xvfb. How to get resolution in that case?
+        logError [i|Couldn't query X11 for screens for display "#{display}"; using default resolution 1920x1080|]
+        return (0, 0, 1920, 1080)
+      Just infos -> do
+        case headMay [(xsi_x_org, xsi_y_org, xsi_width, xsi_height) | X.XineramaScreenInfo {..} <- infos
+                                                                    , xsi_screen_number == fromIntegral screenNumber] of
+          Nothing -> throwIO $ userError [i|Failed to get screen resolution (couldn't find screen number #{screenNumber})|]
+          Just (x, y, w, h) -> return (fromIntegral x, fromIntegral y, fromIntegral w, fromIntegral h)
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,21 @@
+
+import Test.Sandwich
+import Data.Time.Clock
+import Test.Sandwich.Formatters.Print
+
+data Foo = Foo { fooInt :: Int, fooString :: String, fooBar :: Bar } deriving (Show, Eq)
+data Bar = Bar { barInt :: Int, barString :: String } deriving (Show, Eq)
+data Baz = Baz Int String Bar deriving (Show, Eq)
+data Simple = Simple { simpleInt :: Int } deriving (Show, Eq)
+
+
+verySimple :: TopSpec
+verySimple = do
+  it "succeeds" (return ())
+
+main :: IO ()
+main = runSandwich options verySimple
+  where
+    options = defaultOptions {
+      optionsTestArtifactsDirectory = TestArtifactsGeneratedDirectory "test_runs" (show <$> getCurrentTime)
+      }