sandwich-webdriver 0.4.0.2 → 0.5.0.0

raw patch · 16 files changed

+143/−67 lines, 16 filesdep ~sandwichPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: sandwich

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−0
• sandwich-webdriver.cabal +3/−3
• src/Test/Sandwich/WebDriver.hs +25/−7
• src/Test/Sandwich/WebDriver/Config.hs +2/−1
• src/Test/Sandwich/WebDriver/Internal/Action.hs +17/−3
• src/Test/Sandwich/WebDriver/Internal/Binaries/Chrome.hs +4/−3
• src/Test/Sandwich/WebDriver/Internal/Binaries/Common.hs +25/−18
• src/Test/Sandwich/WebDriver/Internal/Binaries/Selenium.hs +4/−3
• src/Test/Sandwich/WebDriver/Internal/Capabilities/Extra.hs +3/−3
• src/Test/Sandwich/WebDriver/Internal/OnDemand.hs +4/−4
• src/Test/Sandwich/WebDriver/Internal/StartWebDriver.hs +3/−3
• src/Test/Sandwich/WebDriver/Internal/Types.hs +22/−9
• src/Test/Sandwich/WebDriver/Video.hs +7/−4
• src/Test/Sandwich/WebDriver/Windows.hs +12/−4
• test/Spec.hs +1/−1
• unix-src/Test/Sandwich/WebDriver/Internal/StartWebDriver/Xvfb.hs +1/−1

@@ -1,5 +1,15 @@ # Changelog for sandwich-webdriver +# 0.5.0.0++* Support `webdriver-0.15.0.0`.+* BREAKING CHANGE: remove `capabilities` from `WdOptions`; use `modifyCapabilities` to adjust capabilities before session creation.+* Add `getWdCapabilities` accessor.+* Add debug logging to `setWindow*` functions.+* Remove Chrome user data dirs created in the test artifacts tree.+* Use the latest `sandwich` process file logging and managed asyncs.+* Put geckodriver --profile-root at run root to deal with long path issues.+ # 0.4.0.2  * Support `webdriver-0.14.0.0`.

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           sandwich-webdriver-version:        0.4.0.2+version:        0.5.0.0 synopsis:       Sandwich integration with Selenium WebDriver description:    Please see the <https://codedownio.github.io/sandwich/docs/extensions/sandwich-webdriver documentation>. category:       Testing@@ -93,7 +93,7 @@     , random     , retry     , safe-    , sandwich >=0.3.0.0+    , sandwich >=0.3.1.0     , sandwich-contexts >=0.3.0.0     , string-interpolate     , temporary@@ -173,7 +173,7 @@     , random     , retry     , safe-    , sandwich >=0.3.0.0+    , sandwich >=0.3.1.0     , sandwich-contexts >=0.3.0.0     , sandwich-webdriver     , string-interpolate

@@ -208,6 +208,9 @@             , driverConfigLogDir = runRoot #endif             , driverConfigChromedriverFlags = chromedriverExtraFlags wdOptions+#if MIN_VERSION_webdriver(0,15,0)+            , driverConfigChromedriverExtraEnv = mempty+#endif             }       return (caps, driverConfig)     BrowserDependenciesFirefox {..} -> do@@ -219,7 +222,10 @@             , W._capabilitiesMozFirefoxOptions = Just ffOptions             } -      profileRootDir <- liftIO $ createTempDirectory webdriverRoot "geckodriver-profile-root"+      -- Put geckodriver profiles in the run root, since Firefox seems to crash+      -- with longer paths. Especially in non-headless mode.+      runRoot <- fromMaybe "/tmp" <$> getRunRoot+      profileRootDir <- liftIO $ createTempDirectory runRoot "geckodriver-profiles"        let driverConfig = W.DriverConfigGeckodriver {             driverConfigGeckodriver = browserDependenciesFirefoxGeckodriver@@ -231,6 +237,9 @@ #endif             , driverConfigGeckodriverFlags = "--profile-root" : profileRootDir : geckodriverExtraFlags wdOptions             -- , driverConfigGeckodriverFlags = geckodriverExtraFlags wdOptions+#if MIN_VERSION_webdriver(0,15,0)+            , driverConfigGeckodriverExtraEnv = mempty+#endif             }       return (caps, driverConfig) @@ -247,7 +256,8 @@   TestWebDriverContext     <$> pure (T.unpack webdriverName)     <*> pure wdc-    <*> pure (wdOptions { capabilities = finalCaps })+    <*> pure wdOptions+    <*> pure finalCaps     <*> liftIO (newMVar mempty)     <*> pure driverConfig     <*> pure downloadDir@@ -278,17 +288,25 @@   TestWebDriverContext {..} <- getContext webdriver    -- Create new session if necessary (this can throw an exception)-  sess <- modifyMVar wdSessionMap $ \sessionMap -> case M.lookup sessionName sessionMap of-    Just sess -> return (sessionMap, sess)+  SessionMapEntry {..} <- modifyMVar wdSessionMap $ \sessionMap -> case M.lookup sessionName sessionMap of+    Just sessionMapEntry -> return (sessionMap, sessionMapEntry)     Nothing -> do-      finalCaps <- pure (capabilities wdOptions)+      (maybeChromeUserDataDir, finalCaps') <- pure wdCapabilities         >>= configureChromeUserDataDir +      finalCaps <- liftIO $ modifyCapabilities wdOptions finalCaps'+       debug [i|Creating session '#{sessionName}'|]       sess <- W.startSession wdContext wdDriverConfig finalCaps sessionName-      return (M.insert sessionName sess sessionMap, sess) -  pushContext webdriverSession (sessionName, sess) $+      let sessionMapEntry = SessionMapEntry {+            sessionMapEntrySession = sess+            , sessionMapEntryDirsToRemove = maybeToList maybeChromeUserDataDir+            }++      return (M.insert sessionName sessionMapEntry sessionMap, sessionMapEntry)++  pushContext webdriverSession (sessionName, sessionMapEntrySession) $     recordVideoIfConfigured sessionName     action 

@@ -6,13 +6,14 @@   WdOptions   , defaultWdOptions   , runMode-  , capabilities   , httpRetryCount   , geckodriverExtraFlags   , chromedriverExtraFlags+  , modifyCapabilities    -- * Accessors for the 'WebDriver' context   , getWdOptions+  , getWdCapabilities   -- , getDisplayNumber   , getDownloadDirectory   , getWebDriverName

@@ -13,6 +13,7 @@ import Test.Sandwich.WebDriver.Types import qualified Test.WebDriver as W import UnliftIO.Concurrent+import UnliftIO.Directory import UnliftIO.Exception  @@ -24,16 +25,29 @@       Nothing -> return (sessionMap, Nothing)       Just x -> return (M.delete session sessionMap, Just x) -  whenJust toClose $ \sess -> W.closeSession wdContext sess+  whenJust toClose $ \(SessionMapEntry {..}) -> do+    W.closeSession wdContext sessionMapEntrySession +    info [i|Closing session: #{sessionMapEntrySession}. sessionMapEntryDirsToRemove: #{sessionMapEntryDirsToRemove}|]++    forM_ sessionMapEntryDirsToRemove $ \dirToRemove -> do+      debug [i|Removing session-specific directory: #{dirToRemove}|]+      catch (removePathForcibly dirToRemove)+            (\(e :: SomeException) -> warn [i|Failed to remove session directory '#{dirToRemove}': '#{e}'|])+ -- | Close all sessions except those listed. closeAllSessionsExcept :: (HasCallStack, MonadLogger m, W.WebDriverBase m) => [SessionName] -> TestWebDriverContext -> m () closeAllSessionsExcept toKeep (TestWebDriverContext {wdSessionMap, wdContext}) = do   toClose <- modifyMVar wdSessionMap $ return . M.partitionWithKey (\name _ -> name `elem` toKeep) -  forM_ (M.toList toClose) $ \(name, sess) ->-    catch (W.closeSession wdContext sess)+  forM_ (M.toList toClose) $ \(name, SessionMapEntry {..}) -> do+    catch (W.closeSession wdContext sessionMapEntrySession)           (\(e :: SomeException) -> warn [i|Failed to destroy session '#{name}': '#{e}'|])++    forM_ sessionMapEntryDirsToRemove $ \dirToRemove -> do+      debug [i|Removing session-specific directory: #{dirToRemove}|]+      catch (removePathForcibly dirToRemove)+            (\(e :: SomeException) -> warn [i|Failed to remove session directory '#{dirToRemove}': '#{e}'|])  -- | Close all sessions. closeAllSessions :: (HasCallStack, MonadLogger m, W.WebDriverBase m) => TestWebDriverContext -> m ()

@@ -32,10 +32,11 @@ import UnliftIO.Directory  -type Constraints m = (+type Constraints context m = (   HasCallStack   , MonadLogger m   , MonadUnliftIO m+  , HasBaseContextMonad context m   )  -- | Manually obtain a chrome binary, according to the 'ChromeToUse' policy,@@ -108,7 +109,7 @@   debug [i|Built chromedriver: #{ret}|]   return $ Right ret -downloadChromeDriverIfNecessary' :: Constraints m => FilePath -> ChromeDriverVersion -> m (Either T.Text FilePath)+downloadChromeDriverIfNecessary' :: Constraints context m => FilePath -> ChromeDriverVersion -> m (Either T.Text FilePath) downloadChromeDriverIfNecessary' toolsDir chromeDriverVersion = runExceptT $ do   let chromeDriverPath = getChromeDriverPath toolsDir chromeDriverVersion @@ -118,7 +119,7 @@    return chromeDriverPath -downloadChromeDriverIfNecessary :: Constraints m => FilePath -> FilePath -> m (Either T.Text FilePath)+downloadChromeDriverIfNecessary :: Constraints context m => FilePath -> FilePath -> m (Either T.Text FilePath) downloadChromeDriverIfNecessary chromePath toolsDir = runExceptT $ do   chromeDriverVersion <- ExceptT $ liftIO $ getChromeDriverVersion chromePath   ExceptT $ downloadChromeDriverIfNecessary' toolsDir chromeDriverVersion

@@ -1,58 +1,65 @@  module Test.Sandwich.WebDriver.Internal.Binaries.Common where -import Control.Exception import Control.Monad import Control.Monad.IO.Class import Control.Monad.IO.Unlift import Control.Monad.Logger import Data.String.Interpolate import qualified Data.Text as T-import System.Directory import System.Exit import System.FilePath-import System.Process import Test.Sandwich.Expectations import Test.Sandwich.Logging+import Test.Sandwich.Misc (HasBaseContextMonad) import Test.Sandwich.WebDriver.Internal.Util+import UnliftIO.Async+import UnliftIO.Directory+import UnliftIO.Exception+import UnliftIO.Process import UnliftIO.Temporary  -downloadAndUnzipToPath :: (MonadUnliftIO m, MonadLogger m) => T.Text -> FilePath -> m (Either T.Text ())+downloadAndUnzipToPath :: (MonadUnliftIO m, MonadLogger m, HasBaseContextMonad context m) => T.Text -> FilePath -> m (Either T.Text ()) downloadAndUnzipToPath downloadPath localPath = leftOnException' $ do   info [i|Downloading #{downloadPath} to #{localPath}|]-  liftIO $ createDirectoryIfMissing True (takeDirectory localPath)+  createDirectoryIfMissing True (takeDirectory localPath)   withSystemTempDirectory "sandwich-webdriver-tool-download" $ \dir -> do     curlDownloadToPath (T.unpack downloadPath) (dir </> "temp.zip")      createProcessWithLogging ((proc "unzip" ["temp.zip", "-d", "unzipped"]) { cwd = Just dir })-      >>= liftIO . waitForProcess >>= (`shouldBe` ExitSuccess)+      >>= \(ps, asy) -> finally (waitForProcess ps >>= (`shouldBe` ExitSuccess))+                                (cancel asy)     let unzipped = dir </> "unzipped"      executables <- (filter (/= "") . T.splitOn "\n" . T.pack) <$> readCreateProcessWithLogging (proc "find" [unzipped, "-executable", "-type", "f"]) ""     case executables of-      [] -> liftIO $ throwIO $ userError [i|No executable found in file downloaded from #{downloadPath}|]+      [] -> throwIO $ userError [i|No executable found in file downloaded from #{downloadPath}|]       [x] -> do-        liftIO $ copyFile (T.unpack x) localPath+        copyFile (T.unpack x) localPath         createProcessWithLogging (shell [i|chmod u+x #{localPath}|])-          >>= liftIO . waitForProcess >>= (`shouldBe` ExitSuccess)-      xs -> liftIO $ throwIO $ userError [i|Found multiple executable found in file downloaded from #{downloadPath}: #{xs}|]+          >>= \(ps, asy) -> finally (waitForProcess ps >>= (`shouldBe` ExitSuccess))+                                    (cancel asy)+      xs -> throwIO $ userError [i|Found multiple executable found in file downloaded from #{downloadPath}: #{xs}|] -downloadAndUntarballToPath :: (MonadUnliftIO m, MonadLogger m) => T.Text -> FilePath -> m (Either T.Text ())+downloadAndUntarballToPath :: (MonadUnliftIO m, MonadLogger m, HasBaseContextMonad context m) => T.Text -> FilePath -> m (Either T.Text ()) downloadAndUntarballToPath downloadPath localPath = leftOnException' $ do   info [i|Downloading #{downloadPath} to #{localPath}|]-  liftIO $ createDirectoryIfMissing True (takeDirectory localPath)+  createDirectoryIfMissing True (takeDirectory localPath)   createProcessWithLogging (shell [i|wget -qO- #{downloadPath} | tar xvz  -C #{takeDirectory localPath}|])-    >>= liftIO . waitForProcess >>= (`shouldBe` ExitSuccess)+    >>= \(ps, asy) -> finally (liftIO $ waitForProcess ps >>= (`shouldBe` ExitSuccess))+                              (cancel asy)   createProcessWithLogging (shell [i|chmod u+x #{localPath}|])-    >>= liftIO . waitForProcess >>= (`shouldBe` ExitSuccess)+    >>= \(ps, asy) -> finally (liftIO $ waitForProcess ps >>= (`shouldBe` ExitSuccess))+                              (cancel asy) -curlDownloadToPath :: (MonadUnliftIO m, MonadLogger m) => String -> FilePath -> m ()+curlDownloadToPath :: (MonadUnliftIO m, MonadLogger m, HasBaseContextMonad context m) => String -> FilePath -> m () curlDownloadToPath downloadPath localPath = do   info [i|Downloading #{downloadPath} to #{localPath}|]-  liftIO $ createDirectoryIfMissing True (takeDirectory localPath)-  p <- createProcessWithLogging (proc "curl" [downloadPath, "-o", localPath, "-s"])-  liftIO (waitForProcess p) >>= (`shouldBe` ExitSuccess)+  createDirectoryIfMissing True (takeDirectory localPath)+  (p, asy) <- createProcessWithLogging (proc "curl" [downloadPath, "-o", localPath, "-s"])+  finally (liftIO (waitForProcess p) >>= (`shouldBe` ExitSuccess))+          (cancel asy)  unlessM :: Monad m => m Bool -> m () -> m () unlessM b s = b >>= (\t -> unless t s)

@@ -24,10 +24,11 @@ import UnliftIO.Directory  -type Constraints m = (+type Constraints context m = (   HasCallStack   , MonadLogger m   , MonadUnliftIO m+  , HasBaseContextMonad context m   )  -- * Obtaining binaries@@ -76,13 +77,13 @@  -- * Lower level helpers -downloadSeleniumIfNecessary :: Constraints m => FilePath -> m (Either T.Text FilePath)+downloadSeleniumIfNecessary :: Constraints context 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   where-    downloadSelenium :: Constraints m => FilePath -> m ()+    downloadSelenium :: Constraints context m => FilePath -> m ()     downloadSelenium seleniumPath = void $ do       info [i|Downloading selenium-server.jar to #{seleniumPath}|]       curlDownloadToPath defaultSeleniumJarUrl seleniumPath

@@ -138,15 +138,15 @@ -- -- This is usually a red herring, chromedriver seems to report it whenever the -- browser fails to start up for whatever reason.-configureChromeUserDataDir :: (Constraints m, HasBaseContextMonad context m, MonadFail m) => W.Capabilities -> m W.Capabilities+configureChromeUserDataDir :: (Constraints m, HasBaseContextMonad context m, MonadFail m) => W.Capabilities -> m (Maybe FilePath, W.Capabilities) configureChromeUserDataDir caps@(W.Capabilities {_capabilitiesGoogChromeOptions=(Just chromeOptions)}) = do   Just dir <- getCurrentFolder   userDataDir <- liftIO $ createTempDirectory dir "chrome-user-data-dir"   let arg = [i|--user-data-dir=#{userDataDir}|]   let finalChromeOptions = chromeOptions                          & over chromeOptionsArgs (Just . (arg :) . fromMaybe [])-  return (caps { W._capabilitiesGoogChromeOptions = Just finalChromeOptions })-configureChromeUserDataDir caps = return caps+  return (Just userDataDir, caps { W._capabilitiesGoogChromeOptions = Just finalChromeOptions })+configureChromeUserDataDir caps = return (Nothing, caps)   -- | This is to make it possible to use Chrome installed by Nix, avoiding errors like this:

@@ -7,19 +7,19 @@ import Data.Text as T import Test.Sandwich import Test.Sandwich.WebDriver.Internal.Types-import UnliftIO.Async+import UnliftIO.Async (wait) import UnliftIO.Exception import UnliftIO.MVar  -getOnDemand :: forall m a. (-  MonadUnliftIO m, MonadLogger m+getOnDemand :: forall context m a. (+  MonadUnliftIO m, MonadLogger m, HasBaseContextMonad context m   ) => MVar (OnDemand a) -> m (Either Text a) -> m a getOnDemand onDemandVar doObtain = do   result <- modifyMVar onDemandVar $ \case     OnDemandErrored msg -> expectationFailure (T.unpack msg)     OnDemandNotStarted -> do-      asy <- async $ do+      asy <- managedAsync "webdriver-on-demand" $ do         let handler :: SomeException -> m a             handler e = do               modifyMVar_ onDemandVar (const $ return $ OnDemandErrored [i|Got exception: #{e}|])

@@ -17,9 +17,9 @@ import Test.Sandwich.WebDriver.Internal.Types import qualified Test.WebDriver as W -#ifndef mingw32_HOST_OS-import Test.Sandwich.WebDriver.Internal.StartWebDriver.Xvfb-#endif+-- #ifndef mingw32_HOST_OS+-- import Test.Sandwich.WebDriver.Internal.StartWebDriver.Xvfb+-- #endif   type Constraints m = (

@@ -46,11 +46,8 @@   -- The @Xvfb@ binary must be installed and on the PATH.  data WdOptions = WdOptions {-  -- | The WebDriver capabilities to use.-  capabilities :: W.Capabilities-   -- | How to handle opening the browser (in a popup window, headless, etc.).-  , runMode :: RunMode+  runMode :: RunMode    -- | Number of times to retry an HTTP request if it times out.   , httpRetryCount :: Int@@ -58,11 +55,14 @@   -- | Pass the --no-sandbox flag to Chrome (useful in GitHub Actions when installing Chrome via Nix).   , chromeNoSandbox :: Bool -  -- | Extra flags to pass to chromedriver+  -- | Extra flags to pass to chromedriver.   , chromedriverExtraFlags :: [String] -  -- | Extra flags to pass to geckodriver+  -- | Extra flags to pass to geckodriver.   , geckodriverExtraFlags :: [String]++  -- | Modify capabilities before session creation.+  , modifyCapabilities :: W.Capabilities -> IO W.Capabilities   }  -- | How to obtain certain binaries "on demand". These may or not be needed based on 'WdOptions', so@@ -106,12 +106,12 @@ -- You should start with this and modify it using the accessors. defaultWdOptions :: WdOptions defaultWdOptions = WdOptions {-  capabilities = W.defaultCaps-  , runMode = Normal+  runMode = Normal   , httpRetryCount = 0   , chromeNoSandbox = False   , chromedriverExtraFlags = []   , geckodriverExtraFlags = []+  , modifyCapabilities = return   }  data OnDemand a =@@ -120,11 +120,20 @@   | OnDemandReady a   | OnDemandErrored Text +data SessionMapEntry = SessionMapEntry {+  sessionMapEntrySession :: W.Session+  -- Per-session directories which we should clean up when a session is closed.+  -- These are typically browser profile directories, which can take up a lot of+  -- space in test artifact directories.+  , sessionMapEntryDirsToRemove :: [FilePath]+  }+ data TestWebDriverContext = TestWebDriverContext {   wdName :: String   , wdContext :: W.WebDriverContext   , wdOptions :: WdOptions-  , wdSessionMap :: MVar (M.Map String W.Session)+  , wdCapabilities :: W.Capabilities+  , wdSessionMap :: MVar (M.Map String SessionMapEntry)   , wdDriverConfig :: W.DriverConfig   , wdDownloadDir :: FilePath @@ -153,6 +162,10 @@ -- | Get the 'WdOptions' associated with the 'WebDriver'. getWdOptions :: TestWebDriverContext -> WdOptions getWdOptions = wdOptions++-- | Get the 'W.Capabilities' associated with the 'WebDriver'.+getWdCapabilities :: TestWebDriverContext -> W.Capabilities+getWdCapabilities = wdCapabilities  -- | Get the X11 display number associated with the 'WebDriver'. -- Only present if running in 'RunInXvfb' mode.

@@ -48,6 +48,7 @@ import Test.Sandwich.WebDriver.Video.Types import Test.Sandwich.WebDriver.Windows import Test.WebDriver+import UnliftIO.Async import UnliftIO.Directory import UnliftIO.Exception @@ -61,6 +62,7 @@ data VideoProcess = VideoProcess {   -- | The process handle   videoProcessProcess :: ProcessHandle+  , videoProcessAsync :: Async ()   , videoProcessCreatedFiles :: [FilePath]   } -- defaultVideoProcess :: ProcessHandle -> VideoProcess@@ -109,7 +111,7 @@   -- | Returns handle to video process and list of files created   -> m VideoProcess startVideoRecording path (width, height, x, y) vs = do-  sess <- getContext webdriver+  -- sess <- getContext webdriver   -- let maybeXvfbSession = getXvfbSession sess   let maybeXvfbSession = Nothing @@ -122,15 +124,16 @@    case logToDisk vs of     False -> do-      p <- createProcessWithLogging cp-      return $ VideoProcess p [videoPath]+      (p, asy) <- createProcessWithLogging cp+      return $ VideoProcess p asy [videoPath]     True -> do       let stdoutPath = path <.> "stdout" <.> "log"       let stderrPath = path <.> "stderr" <.> "log"       liftIO $ bracket (openFile stdoutPath AppendMode) hClose $ \hout ->         bracket (openFile stderrPath AppendMode) hClose $ \herr -> do           (_, _, _, p) <- createProcess (cp { std_out = UseHandle hout, std_err = UseHandle herr })-          return $ VideoProcess p [videoPath, stdoutPath, stderrPath]+          asy <- async $ return ()+          return $ VideoProcess p asy [videoPath, stdoutPath, stderrPath]  -- | Gracefully stop the 'ProcessHandle' returned by 'startVideoRecording'. endVideoRecording :: (

@@ -15,8 +15,10 @@   ) where  import Control.Monad.IO.Class+import Control.Monad.Logger import Control.Monad.Reader import Data.Maybe+import Data.String.Interpolate import Test.Sandwich import Test.Sandwich.WebDriver.Internal.Types import Test.Sandwich.WebDriver.Resolution@@ -25,7 +27,7 @@   -- | Position the window on the left 50% of the screen.-setWindowLeftSide :: (WebDriverMonad m context, MonadReader context m, WebDriver m) => m ()+setWindowLeftSide :: (WebDriverMonad m context, MonadReader context m, MonadLogger m, WebDriver m) => m () setWindowLeftSide = do   sess <- getContext webdriver   (x, y, width, height) <- case runMode $ wdOptions sess of@@ -35,10 +37,12 @@    (screenWidth, screenHeight) <- getScreenPixelDimensions width height +  debug [i|setWindowLeftSide: got screen resolution (x, y, w, h) = #{(x, y, width, height)} and pixel dimensions #{(screenWidth, screenHeight)}|]+   setWindowRect $ Rect (fromIntegral x) (fromIntegral y) (realToFrac (screenWidth / 2.0)) (realToFrac screenHeight)  -- | Position the window on the right 50% of the screen.-setWindowRightSide :: (WebDriverMonad m context, MonadReader context m, WebDriver m) => m ()+setWindowRightSide :: (WebDriverMonad m context, MonadReader context m, MonadLogger m, WebDriver m) => m () setWindowRightSide = do   sess <- getContext webdriver   (x, y, width, height) <- case runMode $ wdOptions sess of@@ -48,10 +52,12 @@    (screenWidth, screenHeight) <- getScreenPixelDimensions width height +  debug [i|setWindowRightSide: got screen resolution (x, y, w, h) = #{(x, y, width, height)} and pixel dimensions #{(screenWidth, screenHeight)}|]+   setWindowRect $ Rect (fromIntegral (x + round (screenWidth / 2.0))) (fromIntegral (y + 0)) (realToFrac (screenWidth / 2.0)) (realToFrac screenHeight)  -- | Fullscreen the browser window.-setWindowFullScreen :: (WebDriverMonad m context, MonadReader context m, WebDriver m) => m ()+setWindowFullScreen :: (WebDriverMonad m context, MonadReader context m, MonadLogger m, WebDriver m) => m () setWindowFullScreen = do   sess <- getContext webdriver   (x, y, width, height) <- case runMode $ wdOptions sess of@@ -61,6 +67,8 @@    (screenWidth, screenHeight) <- getScreenPixelDimensions width height +  debug [i|setWindowFullScreen: got screen resolution (x, y, w, h) = #{(x, y, width, height)} and pixel dimensions #{(screenWidth, screenHeight)}|]+   setWindowRect $ Rect (fromIntegral x) (fromIntegral y) (realToFrac screenWidth) (realToFrac screenHeight)  -- | Get the screen resolution as (x, y, width, height). (The x and y coordinates may be nonzero in multi-monitor setups.)@@ -69,7 +77,7 @@ -- getScreenResolution (TestWebDriverContext {wdWebDriver=(_, maybeXvfbSession)}) = case maybeXvfbSession of --   Nothing -> liftIO getResolution --   Just (XvfbSession {..}) -> liftIO $ getResolutionForDisplay xvfbDisplayNum-getScreenResolution twdc = liftIO getResolution+getScreenResolution _twdc = liftIO getResolution  getScreenPixelDimensions :: (WebDriver m) => Int -> Int -> m (Double, Double) getScreenPixelDimensions width height = do

@@ -21,7 +21,7 @@ -- session not created: probably user data directory is already in use, please specify a unique value for --user-data-dir argument, or don't use --user-data-dir  spec :: TopSpecWithOptions-spec = introduceNixContext (nixpkgsRelease2405 { nixpkgsDerivationAllowUnfree = True }) $+spec = introduceNixContext (nixpkgsRelease2505 { nixpkgsDerivationAllowUnfree = True }) $   introduceWebDriverViaNix defaultWdOptions $ do     it "opens Xkcd and presses the prev button" $ withSession1 $ do       openPage [i|https://www.xkcd.com|]

@@ -101,7 +101,7 @@    -- Start the Xvfb session   authFile <- liftIO $ writeTempFile webdriverRoot ".Xauthority" ""-  p <- createProcessWithLogging $ (+  p <- createProcessWithFileLogging' "xvfb" $ (     proc xvfb [":" <> show serverNum               , "-screen", "0", [i|#{w}x#{h}x24|]               , "-displayfd", [i|#{fd}|]