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 +6/−1
- LICENSE +1/−1
- darwin-src/Test/Sandwich/WebDriver/Resolution.hs +32/−7
- sandwich-webdriver.cabal +5/−5
- src/Test/Sandwich/WebDriver.hs +1/−0
- src/Test/Sandwich/WebDriver/Internal/Binaries/Chrome.hs +36/−14
- src/Test/Sandwich/WebDriver/Internal/Binaries/DetectPlatform.hs +2/−2
- src/Test/Sandwich/WebDriver/Internal/Binaries/Ffmpeg.hs +12/−7
- src/Test/Sandwich/WebDriver/Internal/Binaries/Firefox.hs +36/−11
- src/Test/Sandwich/WebDriver/Internal/Binaries/Selenium.hs +20/−9
- src/Test/Sandwich/WebDriver/Internal/Binaries/Xvfb.hs +11/−4
- src/Test/Sandwich/WebDriver/Internal/Capabilities/Extra.hs +37/−5
- src/Test/Sandwich/WebDriver/Internal/Dependencies.hs +16/−4
- src/Test/Sandwich/WebDriver/Internal/StartWebDriver.hs +5/−2
- src/Test/Sandwich/WebDriver/Internal/Types.hs +4/−0
- src/Test/Sandwich/WebDriver/Types.hs +1/−1
- src/Test/Sandwich/WebDriver/Video.hs +2/−2
- src/Test/Sandwich/WebDriver/Video/Internal.hs +1/−1
- test/Spec.hs +22/−15
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