packages feed

sandwich-webdriver 0.3.0.0 → 0.3.0.1

raw patch · 19 files changed

+250/−91 lines, 19 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Test.Sandwich.WebDriver: allocateWebDriver :: (BaseMonad m context, HasFile context "java", HasFile context "selenium.jar", HasBrowserDependencies context) => WdOptions -> OnDemandOptions -> ExampleT context m WebDriver
+ Test.Sandwich.WebDriver: allocateWebDriver :: forall (m :: Type -> Type) context. (BaseMonad m context, HasFile context "java", HasFile context "selenium.jar", HasBrowserDependencies context) => WdOptions -> OnDemandOptions -> ExampleT context m WebDriver
- Test.Sandwich.WebDriver: cleanupWebDriver :: BaseMonad m context => WebDriver -> ExampleT context m ()
+ Test.Sandwich.WebDriver: cleanupWebDriver :: forall (m :: Type -> Type) context. BaseMonad m context => WebDriver -> ExampleT context m ()
- Test.Sandwich.WebDriver: introduceBrowserDependenciesViaNix :: forall m context. (MonadUnliftIO m, HasBaseContext context, HasNixContext context, HasSomeCommandLineOptions context) => SpecFree (LabelValue "browserDependencies" BrowserDependencies :> context) m () -> SpecFree context m ()
+ Test.Sandwich.WebDriver: introduceBrowserDependenciesViaNix :: forall (m :: Type -> Type) context. (MonadUnliftIO m, HasBaseContext context, HasNixContext context, HasSomeCommandLineOptions context) => SpecFree (LabelValue "browserDependencies" BrowserDependencies :> context) m () -> SpecFree context m ()
- Test.Sandwich.WebDriver: introduceBrowserDependenciesViaNix' :: forall m context. (MonadUnliftIO m, HasBaseContext context, HasNixContext context, HasSomeCommandLineOptions context) => NodeOptions -> SpecFree (LabelValue "browserDependencies" BrowserDependencies :> context) m () -> SpecFree context m ()
+ Test.Sandwich.WebDriver: introduceBrowserDependenciesViaNix' :: forall (m :: Type -> Type) context. (MonadUnliftIO m, HasBaseContext context, HasNixContext context, HasSomeCommandLineOptions context) => NodeOptions -> SpecFree (LabelValue "browserDependencies" BrowserDependencies :> context) m () -> SpecFree context m ()
- Test.Sandwich.WebDriver: introduceWebDriver :: forall context m. (BaseMonad m context, HasSomeCommandLineOptions context) => WebDriverDependencies -> WdOptions -> SpecFree (ContextWithWebdriverDeps context) m () -> SpecFree context m ()
+ Test.Sandwich.WebDriver: introduceWebDriver :: forall context (m :: Type -> Type). (BaseMonad m context, HasSomeCommandLineOptions context) => WebDriverDependencies -> WdOptions -> SpecFree (ContextWithWebdriverDeps context) m () -> SpecFree context m ()
- Test.Sandwich.WebDriver: introduceWebDriver' :: forall m context. BaseMonad m context => WebDriverDependencies -> (WdOptions -> ExampleT (ContextWithBaseDeps context) m WebDriver) -> WdOptions -> SpecFree (ContextWithWebdriverDeps context) m () -> SpecFree context m ()
+ Test.Sandwich.WebDriver: introduceWebDriver' :: forall (m :: Type -> Type) context. BaseMonad m context => WebDriverDependencies -> (WdOptions -> ExampleT (ContextWithBaseDeps context) m WebDriver) -> WdOptions -> SpecFree (ContextWithWebdriverDeps context) m () -> SpecFree context m ()
- Test.Sandwich.WebDriver: introduceWebDriverViaNix :: forall m context. (BaseMonad m context, HasSomeCommandLineOptions context, HasNixContext context) => WdOptions -> SpecFree (ContextWithWebdriverDeps context) m () -> SpecFree context m ()
+ Test.Sandwich.WebDriver: introduceWebDriverViaNix :: forall (m :: Type -> Type) context. (BaseMonad m context, HasSomeCommandLineOptions context, HasNixContext context) => WdOptions -> SpecFree (ContextWithWebdriverDeps context) m () -> SpecFree context m ()
- Test.Sandwich.WebDriver: introduceWebDriverViaNix' :: forall m context. (BaseMonad m context, HasSomeCommandLineOptions context, HasNixContext context) => NodeOptions -> WdOptions -> SpecFree (ContextWithWebdriverDeps context) m () -> SpecFree context m ()
+ Test.Sandwich.WebDriver: introduceWebDriverViaNix' :: forall (m :: Type -> Type) context. (BaseMonad m context, HasSomeCommandLineOptions context, HasNixContext context) => NodeOptions -> WdOptions -> SpecFree (ContextWithWebdriverDeps context) m () -> SpecFree context m ()
- Test.Sandwich.WebDriver: type BaseMonad m context = (HasCallStack, MonadUnliftIO m, MonadMask m, HasBaseContext context)
+ Test.Sandwich.WebDriver: type BaseMonad (m :: Type -> Type) context = (HasCallStack, MonadUnliftIO m, MonadMask m, HasBaseContext context)
- Test.Sandwich.WebDriver: type ContextWithBaseDeps context = -- | Browser dependencies LabelValue "browserDependencies" BrowserDependencies :> FileValue "java" :> FileValue "selenium.jar" :> context
+ Test.Sandwich.WebDriver: type ContextWithBaseDeps context = LabelValue "browserDependencies" BrowserDependencies :> FileValue "java" :> FileValue "selenium.jar" :> context
- Test.Sandwich.WebDriver: type WebDriverMonad m context = (HasCallStack, MonadUnliftIO m, HasWebDriverContext context)
+ Test.Sandwich.WebDriver: type WebDriverMonad (m :: Type -> Type) context = (HasCallStack, MonadUnliftIO m, HasWebDriverContext context)
- Test.Sandwich.WebDriver: type WebDriverSessionMonad m context = (WebDriverMonad m context, MonadReader context m, HasWebDriverSessionContext context)
+ Test.Sandwich.WebDriver: type WebDriverSessionMonad (m :: Type -> Type) context = (WebDriverMonad m context, MonadReader context m, HasWebDriverSessionContext context)
- Test.Sandwich.WebDriver: withSession :: forall m context a. (MonadMask m, MonadBaseControl IO m, HasBaseContext context, HasSomeCommandLineOptions context, WebDriverMonad m context) => Session -> ExampleT (LabelValue "webdriverSession" WebDriverSession :> context) m a -> ExampleT context m a
+ Test.Sandwich.WebDriver: withSession :: forall (m :: Type -> Type) context a. (MonadMask m, MonadBaseControl IO m, HasBaseContext context, HasSomeCommandLineOptions context, WebDriverMonad m context) => Session -> ExampleT (LabelValue "webdriverSession" WebDriverSession :> context) m a -> ExampleT context m a
- Test.Sandwich.WebDriver: withSession1 :: (MonadMask m, MonadBaseControl IO m, HasBaseContext context, HasSomeCommandLineOptions context, WebDriverMonad m context) => ExampleT (LabelValue "webdriverSession" WebDriverSession :> context) m a -> ExampleT context m a
+ Test.Sandwich.WebDriver: withSession1 :: forall (m :: Type -> Type) context a. (MonadMask m, MonadBaseControl IO m, HasBaseContext context, HasSomeCommandLineOptions context, WebDriverMonad m context) => ExampleT (LabelValue "webdriverSession" WebDriverSession :> context) m a -> ExampleT context m a
- Test.Sandwich.WebDriver: withSession2 :: (MonadMask m, MonadBaseControl IO m, HasBaseContext context, HasSomeCommandLineOptions context, WebDriverMonad m context) => ExampleT (LabelValue "webdriverSession" WebDriverSession :> context) m a -> ExampleT context m a
+ Test.Sandwich.WebDriver: withSession2 :: forall (m :: Type -> Type) context a. (MonadMask m, MonadBaseControl IO m, HasBaseContext context, HasSomeCommandLineOptions context, WebDriverMonad m context) => ExampleT (LabelValue "webdriverSession" WebDriverSession :> context) m a -> ExampleT context m a
- Test.Sandwich.WebDriver.Binaries: obtainFfmpeg :: (MonadReader context m, HasBaseContext context, MonadUnliftIO m, MonadLoggerIO m, MonadMask m) => FfmpegToUse -> m (Either Text FilePath)
+ Test.Sandwich.WebDriver.Binaries: obtainFfmpeg :: (MonadReader context m, HasBaseContext context, MonadUnliftIO m, MonadLoggerIO m) => FfmpegToUse -> m (Either Text FilePath)
- Test.Sandwich.WebDriver.Video: type BaseVideoConstraints context m = (MonadLoggerIO m, MonadUnliftIO m, MonadMask m, MonadReader context m, HasBaseContext context, HasWebDriverContext context)
+ Test.Sandwich.WebDriver.Video: type BaseVideoConstraints context (m :: Type -> Type) = (MonadLoggerIO m, MonadUnliftIO m, MonadMask m, MonadReader context m, HasBaseContext context, HasWebDriverContext context)

Files

CHANGELOG.md view
@@ -1,6 +1,11 @@ # Changelog for sandwich-webdriver -# Unreleased+# 0.3.0.1++* Add more debugging statements to binary fetching.+* Fix getResolutionForDisplay on macOS.+* Pass --user-data-dir to chrome.+* Be able to pass --chrome-no-sandbox.  # 0.3.0.0 
LICENSE view
@@ -1,4 +1,4 @@-Copyright Tom McLaughlin (c) 2024+Copyright Tom McLaughlin (c) 2025  All rights reserved. 
darwin-src/Test/Sandwich/WebDriver/Resolution.hs view
@@ -5,6 +5,8 @@   ) where  import Data.Word+import Foreign.C.Types+import Foreign.Ptr   getResolution :: IO (Int, Int, Int, Int)@@ -13,22 +15,45 @@   getResolutionForDisplay (fromIntegral ddid)  -- TODO: currently we just use the "main display" ID.--- When when we return 0 for x and y here, the WebDriver setWindowPos+-- When we return 0 for x and y here, the WebDriver setWindowPos -- should just position the window on the main display. -- This probably won't work at all for xvfb displays, but we have more work to do there... getResolutionForDisplay :: Int -> IO (Int, Int, Int, Int) getResolutionForDisplay ddid = do-  width <- cg_display_pixels_wide (fromIntegral ddid)-  height <- cg_display_pixels_high (fromIntegral ddid)+  mode <- cg_display_copy_display_mode (fromIntegral ddid)++  -- This version gets the dimension in "points" (scaled pixels)+  -- width <- cg_display_pixels_wide (fromIntegral ddid)+  -- height <- cg_display_pixels_high (fromIntegral ddid)++  -- This version should always get the dimensions in actual non-scaled pixels+  width <- cg_display_mode_get_pixel_width mode+  height <- cg_display_mode_get_pixel_height mode++  -- We could actually use a combination of cg_display_pixels_wide and cg_display_mode_get_pixel_width to+  -- get the scaling+   return (0, 0, fromIntegral width, fromIntegral height)  type CGDirectDisplayID = Word32 +data CGDisplayMode+type CGDisplayModeRef = Ptr CGDisplayMode+ foreign import ccall unsafe "<CoreGraphics/CGDisplayConfiguration.h> CGMainDisplayID"   cg_main_display_id :: IO CGDirectDisplayID -foreign import ccall unsafe "<CoreGraphics/CGDisplayConfiguration.h> CGDisplayPixelsWide"-  cg_display_pixels_wide :: CGDirectDisplayID -> IO CGDirectDisplayID+-- foreign import ccall unsafe "<CoreGraphics/CGDisplayConfiguration.h> CGDisplayPixelsWide"+--   cg_display_pixels_wide :: CGDirectDisplayID -> IO CGDirectDisplayID -foreign import ccall unsafe "<CoreGraphics/CGDisplayConfiguration.h> CGDisplayPixelsHigh"-  cg_display_pixels_high :: CGDirectDisplayID -> IO CGDirectDisplayID+-- foreign import ccall unsafe "<CoreGraphics/CGDisplayConfiguration.h> CGDisplayPixelsHigh"+--   cg_display_pixels_high :: CGDirectDisplayID -> IO CGDirectDisplayID++foreign import ccall unsafe "CGDisplayModeGetPixelWidth"+  cg_display_mode_get_pixel_width :: CGDisplayModeRef -> IO CSize++foreign import ccall unsafe "CGDisplayModeGetPixelHeight"+  cg_display_mode_get_pixel_height :: CGDisplayModeRef -> IO CSize++foreign import ccall unsafe "CGDisplayCopyDisplayMode"+  cg_display_copy_display_mode :: CGDirectDisplayID -> IO CGDisplayModeRef
sandwich-webdriver.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.37.0.+-- This file has been generated from package.yaml by hpack version 0.38.0. -- -- see: https://github.com/sol/hpack  name:           sandwich-webdriver-version:        0.3.0.0+version:        0.3.0.1 synopsis:       Sandwich integration with Selenium WebDriver description:    Please see the <https://codedownio.github.io/sandwich/docs/extensions/sandwich-webdriver documentation>. category:       Testing@@ -13,7 +13,7 @@ bug-reports:    https://github.com/codedownio/sandwich/issues author:         Tom McLaughlin maintainer:     tom@codedown.io-copyright:      2024 Tom McLaughlin+copyright:      2025 Tom McLaughlin license:        BSD3 license-file:   LICENSE build-type:     Simple@@ -100,6 +100,7 @@     , sandwich >=0.3.0.0     , sandwich-contexts >=0.3.0.0     , string-interpolate+    , temporary     , text     , time     , transformers@@ -136,8 +137,6 @@         Test.Sandwich.WebDriver.Internal.StartWebDriver.Xvfb     hs-source-dirs:         unix-src-    build-depends:-        temporary  test-suite sandwich-webdriver-test   type: exitcode-stdio-1.0@@ -186,6 +185,7 @@     , sandwich-contexts >=0.3.0.0     , sandwich-webdriver     , string-interpolate+    , temporary     , text     , time     , transformers
src/Test/Sandwich/WebDriver.hs view
@@ -247,4 +247,5 @@     Just Headless -> RunHeadless defaultHeadlessConfig     Just Xvfb -> RunInXvfb (defaultXvfbConfig { xvfbStartFluxbox = optFluxbox })     Just Current -> Normal+  , chromeNoSandbox = optChromeNoSandbox   }
src/Test/Sandwich/WebDriver/Internal/Binaries/Chrome.hs view
@@ -45,15 +45,24 @@   ) => ChromeToUse -> m (Either T.Text FilePath) obtainChrome UseChromeFromPath = do   findExecutable "google-chrome" >>= \case-    Just p -> return $ Right p+    Just p -> do+      debug [i|Found Chrome at #{p}|]+      return $ Right p     Nothing -> findExecutable "google-chrome-stable" >>= \case-      Just p -> return $ Right p+      Just p -> do+        debug [i|Found Chrome at #{p}|]+        return $ Right p       Nothing -> expectationFailure [i|Couldn't find either "google-chrome" or "google-chrome-stable" on the PATH|] obtainChrome (UseChromeAt p) = doesFileExist p >>= \case   False -> return $ Left [i|Path '#{p}' didn't exist|]-  True -> return $ Right p-obtainChrome (UseChromeFromNixpkgs nixContext) =-  Right <$> getBinaryViaNixPackage' @"google-chrome-stable" nixContext "google-chrome"+  True -> do+    debug [i|Found Chrome at #{p}|]+    return $ Right p+obtainChrome (UseChromeFromNixpkgs nixContext) = do+  debug [i|Building Chrome with Nix...|]+  ret <- getBinaryViaNixPackage' @"google-chrome-stable" nixContext "google-chrome"+  debug [i|Built Chrome: #{ret}|]+  return $ Right ret  -- | Manually obtain a @chromedriver@ binary, according to the 'ChromeDriverToUse' policy. obtainChromeDriver :: (@@ -65,26 +74,39 @@   -> m (Either T.Text FilePath) obtainChromeDriver (DownloadChromeDriverFrom toolsDir url) = do   let path = [i|#{toolsDir}/#{chromeDriverExecutable}|]-  unlessM (liftIO $ doesFileExist path) $-    curlDownloadToPath url path+  doesFileExist path >>= \case+    True -> do+      debug [i|chromedriver already existed at #{path}|]+    False -> do+      debug [i|Downloading chromedriver from #{url}...|]+      curlDownloadToPath url path+      debug [i|Downloaded chromedriver to #{path}|]   return $ Right path obtainChromeDriver (DownloadChromeDriverVersion toolsDir chromeDriverVersion) = runExceptT $ do   let path = getChromeDriverPath toolsDir chromeDriverVersion   liftIO (doesFileExist path) >>= \case-    True -> return path+    True -> do+      debug [i|Found chromedriver at #{path}|]+      return path     False -> do-      let downloadPath = getChromeDriverDownloadUrl chromeDriverVersion detectPlatform-      ExceptT $ downloadAndUnzipToPath downloadPath path+      let downloadUrl = getChromeDriverDownloadUrl chromeDriverVersion detectPlatform+      debug [i|Downloading chromedriver from #{downloadUrl}...|]+      ExceptT $ downloadAndUnzipToPath downloadUrl path+      debug [i|Downloaded chromedriver to #{path}|]       return path obtainChromeDriver (DownloadChromeDriverAutodetect toolsDir chromePath) = runExceptT $ do   version <- ExceptT $ liftIO $ getChromeDriverVersion chromePath   ExceptT $ obtainChromeDriver (DownloadChromeDriverVersion toolsDir version) obtainChromeDriver (UseChromeDriverAt path) = doesFileExist path >>= \case   False -> return $ Left [i|Path '#{path}' didn't exist|]-  True -> return $ Right path-obtainChromeDriver (UseChromeDriverFromNixpkgs nixContext) =-  Right <$> getBinaryViaNixPackage' @"chromedriver" nixContext "chromedriver"-+  True -> do+    debug [i|Found chromedriver at #{path}|]+    return $ Right path+obtainChromeDriver (UseChromeDriverFromNixpkgs nixContext) = do+  debug [i|Building chromedriver with Nix|]+  ret <- getBinaryViaNixPackage' @"chromedriver" nixContext "chromedriver"+  debug [i|Built chromedriver: #{ret}|]+  return $ Right ret  downloadChromeDriverIfNecessary' :: Constraints m => FilePath -> ChromeDriverVersion -> m (Either T.Text FilePath) downloadChromeDriverIfNecessary' toolsDir chromeDriverVersion = runExceptT $ do
src/Test/Sandwich/WebDriver/Internal/Binaries/DetectPlatform.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-}  module Test.Sandwich.WebDriver.Internal.Binaries.DetectPlatform (   detectPlatform@@ -9,7 +8,8 @@ import qualified System.Info as SI  -data Platform = Linux | OSX | Windows deriving (Show, Eq)+data Platform = Linux | OSX | Windows+  deriving (Show, Eq)  detectPlatform :: Platform detectPlatform = case SI.os of
src/Test/Sandwich/WebDriver/Internal/Binaries/Ffmpeg.hs view
@@ -8,7 +8,6 @@   , FfmpegToUse(..)   ) where -import Control.Monad.Catch (MonadMask) import Control.Monad.IO.Unlift import Control.Monad.Logger import Control.Monad.Reader@@ -23,17 +22,23 @@ -- | Manually obtain an ffmpeg binary, according to the 'FfmpegToUse' policy. obtainFfmpeg :: (   MonadReader context m, HasBaseContext context-  , MonadUnliftIO m, MonadLoggerIO m, MonadMask m+  , MonadUnliftIO m, MonadLoggerIO m   ) => FfmpegToUse -> m (Either T.Text FilePath) obtainFfmpeg UseFfmpegFromPath = findExecutable "ffmpeg" >>= \case   Nothing -> return $ Left [i|Couldn't find "ffmpeg" on the PATH.|]-  Just p -> return $ Right p+  Just p -> do+    debug [i|Found ffmpeg at #{p}|]+    return $ Right p obtainFfmpeg (UseFfmpegAt path) = doesFileExist path >>= \case   False -> return $ Left [i|Path '#{path}' didn't exist|]-  True -> return $ Right path-obtainFfmpeg (UseFfmpegFromNixpkgs nixContext) =-  Right <$> getBinaryViaNixDerivation' @"ffmpeg" nixContext ffmpegDerivation-+  True -> do+    debug [i|Found ffmpeg at #{path}|]+    return $ Right path+obtainFfmpeg (UseFfmpegFromNixpkgs nixContext) = do+  debug [i|Building ffmpeg with Nix...|]+  ret <- getBinaryViaNixDerivation' @"ffmpeg" nixContext ffmpegDerivation+  debug [i|Built ffmpeg with Nix: #{ret}|]+  return $ Right ret  ffmpegDerivation :: T.Text ffmpegDerivation = [i|
src/Test/Sandwich/WebDriver/Internal/Binaries/Firefox.hs view
@@ -34,13 +34,26 @@   ) => FirefoxToUse -> m (Either T.Text FilePath) obtainFirefox UseFirefoxFromPath = do   findExecutable "firefox" >>= \case-    Just p -> return $ Right p+    Just p -> do+      debug [i|Found firefox: #{p}|]+      return $ Right p     Nothing -> expectationFailure [i|Couldn't find "firefox" on the PATH|] obtainFirefox (UseFirefoxAt p) = doesFileExist p >>= \case   False -> return $ Left [i|Path '#{p}' didn't exist|]-  True -> return $ Right p-obtainFirefox (UseFirefoxFromNixpkgs nixContext) =-  Right <$> getBinaryViaNixPackage' @"firefox" nixContext "firefox"+  True -> do+    debug [i|Found firefox: #{p}|]+    return $ Right p+obtainFirefox (UseFirefoxFromNixpkgs nixContext) = do+  debug [i|Building Firefox with Nix|]+  -- ret <- case os of+  --   "darwin" ->+  --     -- The only Firefox version that currently works on Darwin as of 5/5/2025 is firefox-bin+  --     buildNixPackage' nixContext "firefox-bin" >>= (liftIO . defaultFindFile "firefox")+  --   _ ->+  --     getBinaryViaNixPackage' @"firefox" nixContext "firefox"+  ret <- getBinaryViaNixPackage' @"firefox" nixContext "firefox"+  debug [i|Built Firefox: #{ret}|]+  return $ Right ret  -- | Manually obtain a @geckodriver@ binary, according to the 'GeckoDriverToUse' policy, -- storing it under the provided 'FilePath' if necessary and returning the exact path.@@ -53,23 +66,35 @@   -> m (Either T.Text FilePath) obtainGeckoDriver (DownloadGeckoDriverFrom toolsDir url) = do   let path = [i|#{toolsDir}/#{geckoDriverExecutable}|]-  unlessM (liftIO $ doesFileExist path) $-    curlDownloadToPath url path+  doesFileExist path >>= \case+    True -> do+      debug [i|GeckoDriver already existed at #{path}|]+    False -> do+      debug [i|Downloading GeckoDriver from #{url}...|]+      curlDownloadToPath url path+      debug [i|Downloaded GeckoDriver to #{path}|]   return $ Right path obtainGeckoDriver (DownloadGeckoDriverVersion toolsDir geckoDriverVersion) = runExceptT $ do   let path = getGeckoDriverPath toolsDir geckoDriverVersion-  liftIO (doesFileExist path) >>= \case-    True -> return path+  doesFileExist path >>= \case+    True -> do+      debug [i|GeckoDriver already existed at #{path}|]+      return path     False -> do-      let downloadPath = getGeckoDriverDownloadUrl geckoDriverVersion detectPlatform-      ExceptT $ downloadAndUntarballToPath downloadPath path+      let downloadUrl = getGeckoDriverDownloadUrl geckoDriverVersion detectPlatform+      debug [i|Downloading GeckoDriver from #{downloadUrl}|]+      ExceptT $ downloadAndUntarballToPath downloadUrl path+      debug [i|Downloaded GeckoDriver to #{path}|]       return path obtainGeckoDriver (DownloadGeckoDriverAutodetect toolsDir) = runExceptT $ do   version <- ExceptT $ liftIO $ getGeckoDriverVersion Nothing+  debug [i|Trying to obtain GeckoDriver version #{version} (autodetected)|]   ExceptT $ obtainGeckoDriver (DownloadGeckoDriverVersion toolsDir version) obtainGeckoDriver (UseGeckoDriverAt path) = liftIO (doesFileExist path) >>= \case   False -> return $ Left [i|Path '#{path}' didn't exist|]-  True -> return $ Right path+  True -> do+    debug [i|Found GeckoDriver at #{path}|]+    return $ Right path obtainGeckoDriver (UseGeckoDriverFromNixpkgs nixContext) = Right <$> getBinaryViaNixPackage' @"geckodriver" nixContext "geckodriver"  
src/Test/Sandwich/WebDriver/Internal/Binaries/Selenium.hs view
@@ -15,13 +15,13 @@ import Data.String.Interpolate import qualified Data.Text as T import GHC.Stack-import System.Directory import Test.Sandwich import Test.Sandwich.Contexts.Files import Test.Sandwich.Contexts.Nix import Test.Sandwich.WebDriver.Internal.Binaries.Common import Test.Sandwich.WebDriver.Internal.Binaries.Selenium.Types import Test.Sandwich.WebDriver.Internal.Util+import UnliftIO.Directory   type Constraints m = (@@ -46,24 +46,35 @@   -> m FilePath obtainSelenium (DownloadSeleniumFrom toolsDir url) = do   let path = [i|#{toolsDir}/selenium-server-standalone.jar|]-  unlessM (liftIO $ doesFileExist path) $-    curlDownloadToPath url path+  doesFileExist path >>= \case+    True -> do+      debug [i|Selenium already existed at #{path}|]+    False -> do+      debug [i|Downloading Selenium from #{url} to #{path}|]+      curlDownloadToPath url path   return path obtainSelenium (DownloadSeleniumDefault toolsDir) = do   let path = [i|#{toolsDir}/selenium-server-standalone-3.141.59.jar|]-  unlessM (liftIO $ doesFileExist path) $-    curlDownloadToPath defaultSeleniumJarUrl path+  doesFileExist path >>= \case+    True -> do+      debug [i|Selenium already existed at #{path}|]+    False -> do+      debug [i|Downloading Selenium from #{defaultSeleniumJarUrl} to #{path}|]+      curlDownloadToPath defaultSeleniumJarUrl path   return path obtainSelenium (UseSeleniumAt path) = liftIO (doesFileExist path) >>= \case   False -> expectationFailure [i|Path '#{path}' didn't exist|]-  True -> return path+  True -> do+    debug [i|Found Selenium at #{path}|]+    return path obtainSelenium (UseSeleniumFromNixpkgs nixContext) = do-  buildNixSymlinkJoin' nixContext ["selenium-server-standalone"] >>=+  debug [i|Building selenium-server-standalone with Nix...|]+  ret <- buildNixSymlinkJoin' nixContext ["selenium-server-standalone"] >>=     liftIO . findFirstFile (return . (".jar" `L.isSuffixOf`))-+  debug [i|Got Selenium: #{ret}|]+  return ret  -- * Lower level helpers-  downloadSeleniumIfNecessary :: Constraints m => FilePath -> m (Either T.Text FilePath) downloadSeleniumIfNecessary toolsDir = leftOnException' $ do
src/Test/Sandwich/WebDriver/Internal/Binaries/Xvfb.hs view
@@ -28,10 +28,17 @@   ) => XvfbToUse -> m (Either T.Text FilePath) obtainXvfb UseXvfbFromPath = findExecutable "Xvfb" >>= \case   Nothing -> return $ Left [i|Couldn't find "Xvfb" on the PATH.|]-  Just p -> return $ Right p+  Just p -> do+    debug [i|Found Xvfb at #{p}|]+    return $ Right p obtainXvfb (UseXvfbAt path) = doesFileExist path >>= \case   False -> return $ Left [i|Path '#{path}' didn't exist|]-  True -> return $ Right path-obtainXvfb (UseXvfbFromNixpkgs nixContext) =+  True -> do+    debug [i|Found Xvfb at #{path}|]+    return $ Right path+obtainXvfb (UseXvfbFromNixpkgs nixContext) = do   -- Note: on master *after* release-24.05, there seems to be xorg.xvfb-  Right <$> getBinaryViaNixPackage' @"Xvfb" nixContext "xorg.xorgserver"+  debug [i|Building Xvfb with Nix|]+  ret <- getBinaryViaNixPackage' @"Xvfb" nixContext "xorg.xorgserver"+  debug [i|Built Xvfb: #{ret}|]+  return $ Right ret
src/Test/Sandwich/WebDriver/Internal/Capabilities/Extra.hs view
@@ -5,6 +5,9 @@ module Test.Sandwich.WebDriver.Internal.Capabilities.Extra (   configureHeadlessCapabilities   , configureDownloadCapabilities++  , configureChromeUserDataDir+  , configureChromeNoSandbox   ) where  import Control.Monad.Catch (MonadMask)@@ -21,6 +24,7 @@ import GHC.Stack import Lens.Micro import Lens.Micro.Aeson+import System.IO.Temp import Test.Sandwich import Test.Sandwich.WebDriver.Internal.Binaries.Chrome.Detect (detectChromeVersion) import Test.Sandwich.WebDriver.Internal.Binaries.Chrome.Types (ChromeVersion(..))@@ -122,9 +126,37 @@      options = HM.insert "prefs" (A.Object prefs) chromeExperimentalOptions -    downloadPrefs = [("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", A.String (T.pack downloadDir))]+    downloadPrefs = [+      ("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", A.String (T.pack downloadDir))+      ] configureDownloadCapabilities _ browser = return browser++-- | chromedriver >= 131 started showing the following error:+-- "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".+--+-- This is a regression of some kind, but a fix is to explicitly pass a distinct user data dir.+configureChromeUserDataDir :: (Constraints m, HasBaseContextMonad context m, MonadFail m) => W.Capabilities -> m W.Capabilities+configureChromeUserDataDir caps@(W.Capabilities {W.browser=browser@(W.Chrome {..})}) = do+  Just dir <- getCurrentFolder+  userDataDir <- liftIO $ createTempDirectory dir "chrome-user-data-dir"+  let arg = [i|--user-data-dir=#{userDataDir}|]+  let browser' = browser { W.chromeOptions = arg:chromeOptions }+  return (caps { W.browser = browser' })+configureChromeUserDataDir caps = return caps+++-- | This is to make it possible to use Chrome installed by Nix, avoiding errors like this:+--+-- [76593:76593:0608/101002.800744:FATAL:setuid_sandbox_host.cc(163)] The SUID sandbox helper binary was found,+-- but is not configured correctly. Rather than run without sandboxing I'm aborting now. You need to make sure+-- that /nix/store/6sshf2mnzfy72sqr7k9f2mi36ccczr9a-google-chrome-130.0.6723.91/share/google/chrome/chrome-sandbox+-- is owned by root and has mode 4755.+configureChromeNoSandbox :: (Constraints m, HasBaseContextMonad context m, MonadFail m) => WdOptions -> W.Capabilities -> m W.Capabilities+configureChromeNoSandbox (WdOptions {chromeNoSandbox=True}) caps@(W.Capabilities {W.browser=browser@(W.Chrome {..})}) = do+  let browser' = browser { W.chromeOptions = "--no-sandbox":chromeOptions }+  return (caps { W.browser = browser' })+configureChromeNoSandbox _ caps = return caps
src/Test/Sandwich/WebDriver/Internal/Dependencies.hs view
@@ -101,16 +101,20 @@ type HasBrowserDependencies context = HasLabel context "browserDependencies" BrowserDependencies  getBrowserDependencies :: (-  MonadUnliftIO m, MonadLogger m-  , MonadReader context m, HasBaseContext context+  MonadReader context m, HasBaseContext context+  , MonadUnliftIO m, MonadLogger m   ) => BrowserDependenciesSpec -> m BrowserDependencies getBrowserDependencies BrowserDependenciesSpecChrome {..} = do   chrome <- exceptionOnLeft $ obtainChrome browserDependenciesSpecChromeChrome   chromeDriver <- exceptionOnLeft $ obtainChromeDriver browserDependenciesSpecChromeChromeDriver+  info [i|chrome: #{chrome}|]+  info [i|chromedriver: #{chromeDriver}|]   return $ BrowserDependenciesChrome chrome chromeDriver getBrowserDependencies (BrowserDependenciesSpecFirefox {..}) = do   firefox <- exceptionOnLeft $ obtainFirefox browserDependenciesSpecFirefoxFirefox   geckoDriver <- exceptionOnLeft $ obtainGeckoDriver browserDependenciesSpecFirefoxGeckodriver+  info [i|firefox: #{firefox}|]+  info [i|geckodriver: #{geckoDriver}|]   return $ BrowserDependenciesFirefox firefox geckoDriver  -- | Introduce 'BrowserDependencies' via Nix, using the command line options.@@ -141,15 +145,23 @@       let useChrome = BrowserDependenciesChrome <$> getBinaryViaNixPackage @"google-chrome-stable" "google-chrome"                                                 <*> getBinaryViaNixPackage @"chromedriver" "chromedriver" +      -- let useFirefox = case os of+      --       "darwin" -> do+      --         -- The only Firefox version that currently works on Darwin as of 5/5/2025 is firefox-bin+      --         firefox <- buildNixPackage "firefox-bin" >>= (liftIO . defaultFindFile "firefox")+      --         BrowserDependenciesFirefox firefox <$> getBinaryViaNixPackage @"geckodriver" "geckodriver"+      --       _ -> BrowserDependenciesFirefox <$> getBinaryViaNixPackage @"firefox" "firefox"+      --                                       <*> getBinaryViaNixPackage @"geckodriver" "geckodriver"+       let useFirefox = BrowserDependenciesFirefox <$> getBinaryViaNixPackage @"firefox" "firefox"                                                   <*> getBinaryViaNixPackage @"geckodriver" "geckodriver" -      deps <- case optFirefox of+      deps <- case optBrowserToUse of         Just UseChrome -> useChrome         Just UseFirefox -> useFirefox         Nothing -> useChrome -      debug [i|Got browser dependencies: #{deps}|]+      info [i|Got browser dependencies: #{deps}|]        return deps 
src/Test/Sandwich/WebDriver/Internal/StartWebDriver.hs view
@@ -13,7 +13,7 @@ import Control.Monad.IO.Class import Control.Monad.IO.Unlift import Control.Monad.Logger-import Control.Monad.Reader+import Control.Monad.Reader (MonadReader) import Control.Retry import Data.Default import Data.Function (fix)@@ -137,7 +137,10 @@    -- Final extra capabilities configuration   capabilities <--    configureHeadlessCapabilities wdOptions runMode capabilities'+    pure capabilities'+    >>= configureChromeNoSandbox wdOptions+    >>= configureChromeUserDataDir+    >>= configureHeadlessCapabilities wdOptions runMode     >>= configureDownloadCapabilities downloadDir    -- Make the WebDriver
src/Test/Sandwich/WebDriver/Internal/Types.hs view
@@ -64,6 +64,9 @@    , httpRetryCount :: Int   -- ^ Number of times to retry an HTTP request if it times out.++  , chromeNoSandbox :: Bool+  -- ^ Pass the --no-sandbox flag to Chrome (useful in GitHub Actions when installing Chrome via Nix).   }  -- | How to obtain certain binaries "on demand". These may or not be needed based on 'WdOptions', so@@ -111,6 +114,7 @@   , runMode = Normal   , httpManager = Nothing   , httpRetryCount = 0+  , chromeNoSandbox = False   }  data OnDemand a =
src/Test/Sandwich/WebDriver/Types.hs view
@@ -6,7 +6,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}  module Test.Sandwich.WebDriver.Types (-  -- * Type aliases to make signatures shorter+  -- * Type aliases to make signatures shorter.   BaseMonad   , ContextWithWebdriverDeps   , ContextWithBaseDeps
src/Test/Sandwich/WebDriver/Video.hs view
@@ -34,8 +34,8 @@ import Control.Monad.IO.Class import Control.Monad.IO.Unlift import Control.Monad.Logger hiding (logError)-import Control.Monad.Reader-import Data.Function+import Control.Monad.Reader (MonadReader)+import Data.Function (fix) import Data.String.Interpolate import System.Exit import System.FilePath
src/Test/Sandwich/WebDriver/Video/Internal.hs view
@@ -11,7 +11,6 @@ import Control.Monad.Logger import Control.Monad.Reader import Data.String.Interpolate-import System.FilePath import System.Process import Test.Sandwich import Test.Sandwich.WebDriver.Internal.Binaries.Ffmpeg@@ -29,6 +28,7 @@ import Data.Function ((&), on) import qualified Data.List as L import Data.Maybe+import System.FilePath ((<.>)) import UnliftIO.Environment #endif 
test/Spec.hs view
@@ -6,28 +6,35 @@ import UnliftIO.Temporary import Data.Time.Clock import Data.String.Interpolate+import Test.Sandwich.Contexts.Nix+import System.FilePath+import Test.WebDriver.Commands+import Test.Sandwich.WebDriver+import Control.Monad.IO.Class+import qualified Data.ByteString.Lazy as BL  -spec :: TopSpec-spec = do-  it "works" $ do-    2 `shouldBe` 2+-- We use nixpkgsRelease2405 here, because Chrome/chromedriver > 131 seems to have a bug where we get+-- a message like this in CI:+--+-- 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 -  -- it "successfully runs obtainChromeDriver" $ do-  --   withSystemTempDirectory "test-download" $ \dir -> do-  --     obtainChromeDriver dir (DownloadChromeDriverAutodetect Nothing) >>= \case-  --       Right x -> info [i|Got chromedriver: #{x}|]-  --       Left err -> expectationFailure (T.unpack err)+spec :: TopSpecWithOptions+spec = introduceNixContext (nixpkgsRelease2405 { nixpkgsDerivationAllowUnfree = True }) $+  introduceWebDriverViaNix defaultWdOptions $ do+    it "opens Google and searches" $ withSession1 $ do+      openPage [i|https://www.google.com|]+      search <- findElem (ByCSS [i|*[title="Search"]|])+      click search+      sendKeys "Haskell Sandwich" search+      findElem (ByCSS [i|input[type="submit"]|]) >>= click -  -- it "successfully runs obtainGeckoDriver" $ do-  --   withSystemTempDirectory "test-download" $ \dir -> do-  --     obtainGeckoDriver dir (DownloadGeckoDriverAutodetect Nothing) >>= \case-  --       Right x -> info [i|Got geckoDriver: #{x}|]-  --       Left err -> expectationFailure (T.unpack err)+      Just dir <- getCurrentFolder+      screenshot >>= liftIO . BL.writeFile (dir </> "screenshot.png")   main :: IO ()-main = runSandwich options spec+main = runSandwichWithCommandLineArgs options spec   where     options = defaultOptions {       optionsTestArtifactsDirectory = defaultTestArtifactsDirectory