mirror of
https://github.com/codedownio/sandwich.git
synced 2024-07-07 08:26:19 +03:00
Able to run webdriver demo using Nix
This commit is contained in:
parent
1828e15538
commit
6d36f4fce6
|
@ -11,7 +11,7 @@ import Test.Sandwich.WebDriver
|
|||
|
||||
|
||||
tests :: TopSpec
|
||||
tests = describe "Selenium tests" $ introduceWebDriver (defaultWdOptions "/tmp/tools") $ do
|
||||
tests = describe "Selenium tests" $ introduceWebDriver defaultWdOptions $ do
|
||||
$(getSpecFromFolder defaultGetSpecFromFolderOptions)
|
||||
|
||||
main :: IO ()
|
||||
|
|
|
@ -16,7 +16,7 @@ import Test.WebDriver.Commands
|
|||
|
||||
|
||||
simple :: TopSpecWithOptions
|
||||
simple = introduceWebDriverOptions @() (defaultWdOptions "/tmp/tools") $ do
|
||||
simple = introduceWebDriverOptions @() defaultWdOptions $ do
|
||||
before "Position window" (withSession1 setWindowRightSide) $ do
|
||||
it "opens Google" $ withSession1 $ do
|
||||
openPage [i|https://www.google.com|]
|
||||
|
|
|
@ -63,7 +63,7 @@ claimWebdriver spec = introduceWith' (
|
|||
|
||||
tests :: TopSpecWithOptions
|
||||
tests =
|
||||
introduceWebDriverPool 4 (defaultWdOptions "/tmp/tools") $
|
||||
introduceWebDriverPool 4 defaultWdOptions $
|
||||
parallel $
|
||||
replicateM_ 20 $
|
||||
claimWebdriver $ it "opens Google" $ withSession1 $ openPage "http://www.google.com"
|
||||
|
|
|
@ -13,7 +13,7 @@ import Test.WebDriver.Commands
|
|||
|
||||
|
||||
positioning :: TopSpec
|
||||
positioning = introduceWebDriver (defaultWdOptions "/tmp/tools") $ do
|
||||
positioning = introduceWebDriver defaultWdOptions $ do
|
||||
describe "two windows side by side" $ do
|
||||
it "opens Google" $ withSession1 $ do
|
||||
openPage "http://www.google.com"
|
||||
|
|
|
@ -17,7 +17,7 @@ import UnliftIO.Exception
|
|||
|
||||
|
||||
manualVideo :: TopSpec
|
||||
manualVideo = introduceWebDriver (defaultWdOptions "/tmp/tools") $ do
|
||||
manualVideo = introduceWebDriver defaultWdOptions $ do
|
||||
describe "video recording" $ do
|
||||
it "opens Google" $ withSession1 $ do
|
||||
openPage "http://www.google.com"
|
||||
|
|
|
@ -1,8 +1,11 @@
|
|||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE NumericUnderscores #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
module Main where
|
||||
|
||||
import Control.Concurrent
|
||||
|
@ -11,12 +14,13 @@ import qualified Data.ByteString.Lazy as BL
|
|||
import Data.String.Interpolate
|
||||
import System.FilePath
|
||||
import Test.Sandwich
|
||||
import Test.Sandwich.Contexts.Nix
|
||||
import Test.Sandwich.WebDriver
|
||||
import Test.WebDriver.Commands
|
||||
|
||||
|
||||
simple :: TopSpecWithOptions
|
||||
simple = introduceWebDriverOptions @() (defaultWdOptions "/tmp/tools") $ do
|
||||
simple = introduceNixContext nixpkgsReleaseDefault $ introduceWebDriverViaNix defaultWdOptions $ do
|
||||
it "opens Google and searches" $ withSession1 $ do
|
||||
openPage [i|https://www.google.com|]
|
||||
search <- findElem (ByCSS [i|*[title="Search"]|])
|
||||
|
@ -27,7 +31,7 @@ simple = introduceWebDriverOptions @() (defaultWdOptions "/tmp/tools") $ do
|
|||
Just dir <- getCurrentFolder
|
||||
screenshot >>= liftIO . BL.writeFile (dir </> "screenshot.png")
|
||||
|
||||
liftIO $ threadDelay 3000000
|
||||
liftIO $ threadDelay 3_000_000
|
||||
|
||||
testOptions = defaultOptions {
|
||||
optionsTestArtifactsDirectory = defaultTestArtifactsDirectory
|
||||
|
|
|
@ -31,6 +31,7 @@ executable demo-webdriver
|
|||
, bytestring
|
||||
, filepath
|
||||
, sandwich
|
||||
, sandwich-contexts
|
||||
, sandwich-webdriver
|
||||
, string-interpolate
|
||||
, webdriver
|
||||
|
|
|
@ -7,6 +7,7 @@ dependencies:
|
|||
- bytestring
|
||||
- filepath
|
||||
- sandwich
|
||||
- sandwich-contexts
|
||||
- sandwich-webdriver
|
||||
- string-interpolate
|
||||
- webdriver
|
||||
|
|
|
@ -42,7 +42,7 @@ tests = do
|
|||
UnitTests1.tests
|
||||
UnitTests2.tests
|
||||
|
||||
introduceWebDriver (defaultWdOptions "/tmp/tools") $
|
||||
introduceWebDriver defaultWdOptions $
|
||||
describe "Selenium tests" $ do
|
||||
SeleniumTests1.tests
|
||||
SeleniumTests2.tests
|
||||
|
@ -71,7 +71,7 @@ import Test.Sandwich.WebDriver
|
|||
#insert_test_imports
|
||||
|
||||
tests :: TopSpec
|
||||
tests = describe "Selenium tests" $ introduceWebDriver (defaultWdOptions "/tmp/tools") $ do
|
||||
tests = describe "Selenium tests" $ introduceWebDriver defaultWdOptions $ do
|
||||
$(getSpecFromFolder defaultGetSpecFromFolderOptions)
|
||||
|
||||
main :: IO ()
|
||||
|
|
|
@ -13,7 +13,7 @@ import Test.Sandwich.WebDriver
|
|||
import Test.WebDriver
|
||||
|
||||
spec :: TopSpec
|
||||
spec = introduceWebDriver (defaultWdOptions "/tmp/tools") $ do
|
||||
spec = introduceWebDriver defaultWdOptions $ do
|
||||
it "opens Google and searches" $ withSession1 $ do
|
||||
openPage "http://www.google.com"
|
||||
search <- findElem (ByCSS "*[title='Search']")
|
||||
|
@ -36,7 +36,7 @@ For example, the code below opens two windows with a different site in each.
|
|||
|
||||
```haskell
|
||||
spec :: TopSpec
|
||||
spec = introduceWebDriver (defaultWdOptions "/tmp/tools") $ do
|
||||
spec = introduceWebDriver defaultWdOptions $ do
|
||||
describe "two browser sessions" $ do
|
||||
it "opens Google" $ withSession1 $ openPage "http://www.google.com"
|
||||
it "opens Yahoo" $ withSession2 $ openPage "http://www.yahoo.com"
|
||||
|
@ -49,7 +49,7 @@ The code below extends the previous example with window positioning. You can fin
|
|||
|
||||
```haskell
|
||||
positioning :: TopSpec
|
||||
positioning = introduceWebDriver (defaultWdOptions "/tmp/tools") $ do
|
||||
positioning = introduceWebDriver defaultWdOptions $ do
|
||||
describe "two windows side by side" $ do
|
||||
it "opens Google" $ withSession1 $ do
|
||||
openPage "http://www.google.com"
|
||||
|
@ -69,7 +69,7 @@ This package makes it easy to run Selenium tests in the background, using either
|
|||
Many browsers now have the ability to natively run in headless mode. For example, passing these modified `WdOptions` to `introduceWebDriver` will run using headless Firefox.
|
||||
|
||||
```haskell
|
||||
wdOptions = (defaultWdOptions "/tmp/tools") {
|
||||
wdOptions = defaultWdOptions {
|
||||
capabilities = firefoxCapabilities Nothing
|
||||
, runMode = RunHeadless defaultHeadlessConfig
|
||||
}
|
||||
|
@ -84,7 +84,7 @@ Xvfb can be used to run your browser on a separate, "virtual" X11 display, diffe
|
|||
Xvfb mode can be configured manually just like headless mode.
|
||||
|
||||
```haskell
|
||||
wdOptions = (defaultWdOptions "/tmp/tools") {
|
||||
wdOptions = defaultWdOptions {
|
||||
capabilities = chromeCapabilities
|
||||
, runMode = RunInXvfb XvfbConfig
|
||||
}
|
||||
|
@ -106,7 +106,7 @@ Using the methods in [Test.Sandwich.WebDriver.Video](http://hackage.haskell.org/
|
|||
|
||||
```haskell
|
||||
manualVideo :: TopSpec
|
||||
manualVideo = introduceWebDriver (defaultWdOptions "/tmp/tools") $ do
|
||||
manualVideo = introduceWebDriver defaultWdOptions $ do
|
||||
describe "video recording" $ do
|
||||
it "opens Google" $ withSession1 $ do
|
||||
openPage "http://www.google.com"
|
||||
|
@ -204,7 +204,7 @@ Having written these functions, we can finally write our tests. The following wi
|
|||
```haskell
|
||||
tests :: TopSpecWithOptions
|
||||
tests =
|
||||
introduceWebDriverPool 4 (defaultWdOptions "/tmp/tools") $
|
||||
introduceWebDriverPool 4 defaultWdOptions $
|
||||
parallel $
|
||||
replicateM_ 20 $
|
||||
claimWebdriver $
|
||||
|
|
|
@ -80,7 +80,7 @@ simple = introduceWebDriver wdOptions $ do
|
|||
|
||||
-- webdriverPool = Label :: Label "webdriverPool" (Pool WdSession)
|
||||
|
||||
wdOptions = (defaultWdOptions "/tmp/tools") {
|
||||
wdOptions = defaultWdOptions {
|
||||
-- capabilities = chromeCapabilities
|
||||
capabilities = firefoxCapabilities Nothing
|
||||
-- capabilities = headlessFirefoxCapabilities
|
||||
|
|
|
@ -5,7 +5,7 @@ import Test.Sandwich
|
|||
import Test.Sandwich.WebDriver
|
||||
import Test.WebDriver
|
||||
|
||||
wdOptions = (defaultWdOptions "/tmp/tools") {
|
||||
wdOptions = defaultWdOptions {
|
||||
capabilities = firefoxCapabilities Nothing
|
||||
, runMode = RunHeadless defaultHeadlessConfig
|
||||
}
|
||||
|
|
|
@ -34,6 +34,7 @@ library
|
|||
Test.Sandwich.WebDriver.Internal.Binaries.DetectChrome
|
||||
Test.Sandwich.WebDriver.Internal.Binaries.DetectFirefox
|
||||
Test.Sandwich.WebDriver.Internal.Binaries.DetectPlatform
|
||||
Test.Sandwich.WebDriver.Internal.BrowserDependencies
|
||||
Test.Sandwich.WebDriver.Internal.Capabilities
|
||||
Test.Sandwich.WebDriver.Internal.Capabilities.Extra
|
||||
Test.Sandwich.WebDriver.Internal.Screenshots
|
||||
|
|
|
@ -1,7 +1,8 @@
|
|||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE QuantifiedConstraints #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
module Test.Sandwich.WebDriver (
|
||||
-- * Introducing a WebDriver server
|
||||
|
@ -35,7 +36,6 @@ module Test.Sandwich.WebDriver (
|
|||
, module Test.Sandwich.WebDriver.Types
|
||||
) where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Logger
|
||||
import Control.Monad.Reader
|
||||
|
@ -43,6 +43,7 @@ import Data.IORef
|
|||
import qualified Data.Map as M
|
||||
import Data.Maybe
|
||||
import Data.String.Interpolate
|
||||
import qualified Data.Text as T
|
||||
import Test.Sandwich
|
||||
import Test.Sandwich.Contexts.Files
|
||||
import Test.Sandwich.Contexts.Nix
|
||||
|
@ -50,6 +51,7 @@ import Test.Sandwich.Internal
|
|||
import Test.Sandwich.WebDriver.Class
|
||||
import Test.Sandwich.WebDriver.Config
|
||||
import Test.Sandwich.WebDriver.Internal.Action
|
||||
import Test.Sandwich.WebDriver.Internal.BrowserDependencies
|
||||
import Test.Sandwich.WebDriver.Internal.StartWebDriver
|
||||
import Test.Sandwich.WebDriver.Internal.Types
|
||||
import Test.Sandwich.WebDriver.Types
|
||||
|
@ -57,6 +59,7 @@ import qualified Test.WebDriver as W
|
|||
import qualified Test.WebDriver.Config as W
|
||||
import qualified Test.WebDriver.Session as W
|
||||
import UnliftIO.MVar
|
||||
import UnliftIO.Process
|
||||
|
||||
|
||||
-- | This is the main 'introduce' method for creating a WebDriver.
|
||||
|
@ -65,24 +68,39 @@ introduceWebDriver :: (
|
|||
) => WdOptions -> SpecFree (LabelValue "webdriver" WebDriver :> context) m () -> SpecFree context m ()
|
||||
introduceWebDriver wdOptions = undefined -- introduce "Introduce WebDriver session" webdriver (allocateWebDriver wdOptions) cleanupWebDriver
|
||||
|
||||
introduceWebDriverViaNix :: (
|
||||
BaseMonadContext m context, HasNixContext context, HasFile context "java"
|
||||
) => WdOptions -> SpecFree (LabelValue "webdriver" WebDriver :> context) m () -> SpecFree context m ()
|
||||
type ContextWithWebdriverDeps context =
|
||||
LabelValue "webdriver" WebDriver
|
||||
:> LabelValue "browserDependencies" BrowserDependencies
|
||||
:> LabelValue "file-java" (EnvironmentFile "java")
|
||||
:> LabelValue "file-selenium.jar" (EnvironmentFile "selenium.jar")
|
||||
:> context
|
||||
|
||||
introduceWebDriverViaNix :: forall m context. (
|
||||
BaseMonadContext m context, HasSomeCommandLineOptions context, HasNixContext context
|
||||
) => WdOptions -> SpecFree (ContextWithWebdriverDeps context) m () -> SpecFree context m ()
|
||||
introduceWebDriverViaNix wdOptions =
|
||||
introduce "Introduce WebDriver session" webdriver (allocateWebDriver wdOptions) cleanupWebDriver
|
||||
introduceFileViaNixPackage @"selenium.jar" "selenium-server-standalone" tryFindSeleniumJar
|
||||
. introduceBinaryViaNixPackage @"java" "jre"
|
||||
. introduceBrowserDependencies
|
||||
. introduce "Introduce WebDriver session" webdriver (allocateWebDriver wdOptions) cleanupWebDriver
|
||||
where
|
||||
tryFindSeleniumJar :: FilePath -> IO FilePath
|
||||
tryFindSeleniumJar path = (T.unpack . T.strip . T.pack) <$> readCreateProcess (proc "find" [path, "-name", "*.jar"]) ""
|
||||
|
||||
-- | Same as introduceWebDriver, but merges command line options into the 'WdOptions'.
|
||||
introduceWebDriverOptions :: forall a context m. (
|
||||
BaseMonadContext m context, HasCommandLineOptions context a, HasFile context "java"
|
||||
BaseMonadContext m context, HasSomeCommandLineOptions context
|
||||
)
|
||||
=> WdOptions -> SpecFree (LabelValue "webdriver" WebDriver :> context) m () -> SpecFree context m ()
|
||||
introduceWebDriverOptions wdOptions = introduce "Introduce WebDriver session" webdriver alloc cleanupWebDriver
|
||||
where alloc = do
|
||||
clo <- getCommandLineOptions
|
||||
allocateWebDriver (addCommandLineOptionsToWdOptions @a clo wdOptions)
|
||||
introduceWebDriverOptions wdOptions = undefined -- introduce "Introduce WebDriver session" webdriver alloc cleanupWebDriver
|
||||
-- where alloc = do
|
||||
-- clo <- getCommandLineOptions
|
||||
-- allocateWebDriver (addCommandLineOptionsToWdOptions @a clo wdOptions)
|
||||
|
||||
-- | Allocate a WebDriver using the given options.
|
||||
allocateWebDriver :: (BaseMonad m, HasBaseContext context, HasFile context "java") => WdOptions -> ExampleT context m WebDriver
|
||||
allocateWebDriver :: (
|
||||
BaseMonad m, HasBaseContext context, HasFile context "java", HasFile context "selenium.jar", HasBrowserDependencies context
|
||||
) => WdOptions -> ExampleT context m WebDriver
|
||||
allocateWebDriver wdOptions = do
|
||||
debug "Beginning allocateWebDriver"
|
||||
dir <- fromMaybe "/tmp" <$> getCurrentFolder
|
||||
|
@ -91,7 +109,10 @@ allocateWebDriver wdOptions = do
|
|||
-- | Allocate a WebDriver using the given options and putting logs under the given path.
|
||||
allocateWebDriver' :: FilePath -> WdOptions -> IO WebDriver
|
||||
allocateWebDriver' runRoot wdOptions = do
|
||||
runNoLoggingT $ flip runReaderT (undefined :: LabelValue "file-java" (EnvironmentFile "java")) $ startWebDriver wdOptions runRoot
|
||||
let ctx = (undefined :: LabelValue "file-java" (EnvironmentFile "java"))
|
||||
:> (undefined :: LabelValue "file-selenium.jar" (EnvironmentFile "selenium.jar"))
|
||||
:> (undefined :: LabelValue "browserDependencies" BrowserDependencies)
|
||||
runNoLoggingT $ flip runReaderT ctx $ startWebDriver wdOptions runRoot
|
||||
|
||||
-- | Clean up the given WebDriver.
|
||||
cleanupWebDriver :: (BaseMonad m) => WebDriver -> ExampleT context m ()
|
||||
|
@ -107,7 +128,9 @@ cleanupWebDriver' sess = do
|
|||
stopWebDriver sess
|
||||
|
||||
-- | Run a given example using a given Selenium session.
|
||||
withSession :: forall m context a. (WebDriverMonad m context) => Session -> ExampleT (ContextWithSession context) m a -> ExampleT context m a
|
||||
withSession :: forall m context a. (
|
||||
WebDriverMonad m context
|
||||
) => Session -> ExampleT (ContextWithSession context) m a -> ExampleT context m a
|
||||
withSession session (ExampleT readerMonad) = do
|
||||
WebDriver {..} <- getContext webdriver
|
||||
-- Create new session if necessary (this can throw an exception)
|
||||
|
@ -145,30 +168,9 @@ getSessions = do
|
|||
-- | Merge the options from the 'CommandLineOptions' into some 'WdOptions'.
|
||||
addCommandLineOptionsToWdOptions :: CommandLineOptions a -> WdOptions -> WdOptions
|
||||
addCommandLineOptionsToWdOptions (CommandLineOptions {optWebdriverOptions=(CommandLineWebdriverOptions {..})}) wdOptions@(WdOptions {..}) = wdOptions {
|
||||
capabilities = case optFirefox of
|
||||
Just UseFirefox -> firefoxCapabilities fbp
|
||||
Just UseChrome -> chromeCapabilities cbp
|
||||
Nothing -> case cbp of
|
||||
Just p -> chromeCapabilities (Just p)
|
||||
Nothing -> case fbp of
|
||||
Just p -> firefoxCapabilities (Just p)
|
||||
Nothing -> capabilities
|
||||
|
||||
, runMode = case optDisplay of
|
||||
Nothing -> runMode
|
||||
Just Headless -> RunHeadless defaultHeadlessConfig
|
||||
Just Xvfb -> RunInXvfb (defaultXvfbConfig { xvfbStartFluxbox = optFluxbox })
|
||||
Just Current -> Normal
|
||||
|
||||
, seleniumToUse = maybe seleniumToUse UseSeleniumAt optSeleniumJar
|
||||
|
||||
, chromeBinaryPath = cbp
|
||||
, chromeDriverToUse = maybe chromeDriverToUse UseChromeDriverAt optChromeDriver
|
||||
|
||||
, firefoxBinaryPath = fbp
|
||||
, geckoDriverToUse = maybe geckoDriverToUse UseGeckoDriverAt optGeckoDriver
|
||||
runMode = case optDisplay of
|
||||
Nothing -> runMode
|
||||
Just Headless -> RunHeadless defaultHeadlessConfig
|
||||
Just Xvfb -> RunInXvfb (defaultXvfbConfig { xvfbStartFluxbox = optFluxbox })
|
||||
Just Current -> Normal
|
||||
}
|
||||
|
||||
where
|
||||
cbp = optChromeBinary <|> chromeBinaryPath
|
||||
fbp = optFirefoxBinary <|> firefoxBinaryPath
|
||||
|
|
|
@ -4,16 +4,14 @@ module Test.Sandwich.WebDriver.Config (
|
|||
WdOptions
|
||||
, defaultWdOptions
|
||||
, runMode
|
||||
, seleniumToUse
|
||||
, chromeBinaryPath
|
||||
, chromeDriverToUse
|
||||
, firefoxBinaryPath
|
||||
, geckoDriverToUse
|
||||
, capabilities
|
||||
, httpManager
|
||||
, httpRetryCount
|
||||
, saveSeleniumMessageHistory
|
||||
|
||||
-- * Browser options
|
||||
, BrowserDependencies(..)
|
||||
|
||||
-- * Run mode constructors
|
||||
, RunMode(..)
|
||||
|
||||
|
|
|
@ -81,8 +81,8 @@ obtainChromeDriver toolsDir (DownloadChromeDriverVersion chromeDriverVersion) =
|
|||
let downloadPath = getChromeDriverDownloadUrl chromeDriverVersion detectPlatform
|
||||
ExceptT $ downloadAndUnzipToPath downloadPath path
|
||||
return path
|
||||
obtainChromeDriver toolsDir (DownloadChromeDriverAutodetect maybeChromePath) = runExceptT $ do
|
||||
version <- ExceptT $ liftIO $ getChromeDriverVersion maybeChromePath
|
||||
obtainChromeDriver toolsDir (DownloadChromeDriverAutodetect chromePath) = runExceptT $ do
|
||||
version <- ExceptT $ liftIO $ getChromeDriverVersion chromePath
|
||||
ExceptT $ obtainChromeDriver toolsDir (DownloadChromeDriverVersion version)
|
||||
obtainChromeDriver _ (UseChromeDriverAt path) = liftIO (doesFileExist path) >>= \case
|
||||
False -> return $ Left [i|Path '#{path}' didn't exist|]
|
||||
|
@ -135,9 +135,9 @@ downloadChromeDriverIfNecessary' toolsDir chromeDriverVersion = runExceptT $ do
|
|||
|
||||
return chromeDriverPath
|
||||
|
||||
downloadChromeDriverIfNecessary :: Constraints m => Maybe FilePath -> FilePath -> m (Either T.Text FilePath)
|
||||
downloadChromeDriverIfNecessary maybeChromePath toolsDir = runExceptT $ do
|
||||
chromeDriverVersion <- ExceptT $ liftIO $ getChromeDriverVersion maybeChromePath
|
||||
downloadChromeDriverIfNecessary :: Constraints m => FilePath -> FilePath -> m (Either T.Text FilePath)
|
||||
downloadChromeDriverIfNecessary chromePath toolsDir = runExceptT $ do
|
||||
chromeDriverVersion <- ExceptT $ liftIO $ getChromeDriverVersion chromePath
|
||||
ExceptT $ downloadChromeDriverIfNecessary' toolsDir chromeDriverVersion
|
||||
|
||||
getChromeDriverPath :: FilePath -> ChromeDriverVersion -> FilePath
|
||||
|
|
|
@ -6,6 +6,8 @@ module Test.Sandwich.WebDriver.Internal.Binaries.DetectChrome (
|
|||
detectChromeVersion
|
||||
, getChromeDriverVersion
|
||||
, getChromeDriverDownloadUrl
|
||||
|
||||
, findChromeInEnvironment
|
||||
) where
|
||||
|
||||
import Control.Exception
|
||||
|
@ -62,10 +64,8 @@ findChromeInEnvironment =
|
|||
, "google-chrome-stable" -- May be found on NixOS
|
||||
]
|
||||
|
||||
detectChromeVersion :: Maybe FilePath -> IO (Either T.Text ChromeVersion)
|
||||
detectChromeVersion maybeChromePath = leftOnException $ runExceptT $ do
|
||||
chromeToUse <- liftIO $ maybe findChromeInEnvironment pure maybeChromePath
|
||||
|
||||
detectChromeVersion :: FilePath -> IO (Either T.Text ChromeVersion)
|
||||
detectChromeVersion chromeToUse = leftOnException $ runExceptT $ do
|
||||
(exitCode, stdout, stderr) <- liftIO $ readCreateProcessWithExitCode (shell (chromeToUse <> " --version | grep -Eo \"[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\"")) ""
|
||||
|
||||
rawString <- case exitCode of
|
||||
|
@ -76,9 +76,9 @@ detectChromeVersion maybeChromePath = leftOnException $ runExceptT $ do
|
|||
[tReadMay -> Just w, tReadMay -> Just x, tReadMay -> Just y, tReadMay -> Just z] -> return $ ChromeVersion (w, x, y, z)
|
||||
_ -> throwE [i|Failed to parse google-chrome version from string: '#{rawString}'|]
|
||||
|
||||
getChromeDriverVersion :: Maybe FilePath -> IO (Either T.Text ChromeDriverVersion)
|
||||
getChromeDriverVersion maybeChromePath = runExceptT $ do
|
||||
chromeVersion <- ExceptT $ liftIO $ detectChromeVersion maybeChromePath
|
||||
getChromeDriverVersion :: FilePath -> IO (Either T.Text ChromeDriverVersion)
|
||||
getChromeDriverVersion chromePath = runExceptT $ do
|
||||
chromeVersion <- ExceptT $ liftIO $ detectChromeVersion chromePath
|
||||
ExceptT $ getChromeDriverVersion' chromeVersion
|
||||
|
||||
getChromeDriverVersion' :: ChromeVersion -> IO (Either T.Text ChromeDriverVersion)
|
||||
|
|
|
@ -0,0 +1,37 @@
|
|||
{-# LANGUAGE AllowAmbiguousTypes #-}
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE QuantifiedConstraints #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
module Test.Sandwich.WebDriver.Internal.BrowserDependencies where
|
||||
|
||||
import Control.Monad.IO.Unlift
|
||||
import Data.String.Interpolate
|
||||
import Test.Sandwich
|
||||
import Test.Sandwich.Contexts.Files
|
||||
import Test.Sandwich.Contexts.Nix
|
||||
import Test.Sandwich.WebDriver.Internal.Types
|
||||
|
||||
|
||||
introduceBrowserDependencies :: forall m context. (
|
||||
MonadUnliftIO m, HasBaseContext context, HasNixContext context, HasSomeCommandLineOptions context
|
||||
) => SpecFree (LabelValue "browserDependencies" BrowserDependencies :> context) m () -> SpecFree context m ()
|
||||
introduceBrowserDependencies = introduce "Introduce browser dependencies" browserDependencies alloc (const $ return ())
|
||||
where
|
||||
alloc = do
|
||||
SomeCommandLineOptions (CommandLineOptions {optWebdriverOptions=(CommandLineWebdriverOptions {..})}) <- getSomeCommandLineOptions
|
||||
|
||||
deps <- case optFirefox of
|
||||
Just UseChrome ->
|
||||
BrowserDependenciesChrome <$> getBinaryViaNixPackage @"google-chrome-stable" "google-chrome"
|
||||
<*> getBinaryViaNixPackage @"chromedriver" "chromedriver"
|
||||
Just UseFirefox ->
|
||||
BrowserDependenciesFirefox <$> getBinaryViaNixPackage @"firefox" "firefox"
|
||||
<*> getBinaryViaNixPackage @"geckodriver" "geckodriver"
|
||||
_ ->
|
||||
BrowserDependenciesFirefox <$> getBinaryViaNixPackage @"firefox" "firefox"
|
||||
<*> getBinaryViaNixPackage @"geckodriver" "geckodriver"
|
||||
debug [i|Got browser dependencies: #{deps}|]
|
||||
return deps
|
|
@ -45,9 +45,13 @@ fromText = id
|
|||
type Constraints m = (HasCallStack, MonadLogger m, MonadUnliftIO m, MonadBaseControl IO m, MonadMask m)
|
||||
|
||||
-- | Add headless configuration to the Chrome browser
|
||||
configureHeadlessCapabilities :: Constraints m => WdOptions -> RunMode -> W.Capabilities -> m W.Capabilities
|
||||
configureHeadlessCapabilities :: (Constraints m) => WdOptions -> RunMode -> W.Capabilities -> m W.Capabilities
|
||||
configureHeadlessCapabilities wdOptions (RunHeadless (HeadlessConfig {..})) caps@(W.Capabilities {W.browser=browser@(W.Chrome {..})}) = do
|
||||
headlessArg <- liftIO (detectChromeVersion (chromeBinaryPath wdOptions)) >>= \case
|
||||
chromeBinaryPath <- case chromeBinary of
|
||||
Nothing -> expectationFailure [i|Chrome capabilities didn't define chromeBinary in configureHeadlessCapabilities|]
|
||||
Just x -> pure x
|
||||
|
||||
headlessArg <- liftIO (detectChromeVersion chromeBinaryPath) >>= \case
|
||||
Left err -> do
|
||||
warn [i|Couldn't determine chrome version when configuring headless capabilities (err: #{err}); passing --headless|]
|
||||
return "--headless"
|
||||
|
|
|
@ -29,12 +29,13 @@ import Test.Sandwich
|
|||
import Test.Sandwich.Contexts.Files
|
||||
import Test.Sandwich.Contexts.Util.Ports (findFreePortOrException)
|
||||
import Test.Sandwich.Util.Process
|
||||
import Test.Sandwich.WebDriver.Internal.Binaries
|
||||
import Test.Sandwich.WebDriver.Internal.Capabilities.Extra
|
||||
import Test.Sandwich.WebDriver.Internal.Types
|
||||
import Test.Sandwich.WebDriver.Internal.Util
|
||||
import qualified Test.WebDriver as W
|
||||
import UnliftIO.Async
|
||||
import UnliftIO.Process
|
||||
import UnliftIO.Timeout
|
||||
|
||||
#ifndef mingw32_HOST_OS
|
||||
import Test.Sandwich.WebDriver.Internal.StartWebDriver.Xvfb
|
||||
|
@ -45,9 +46,10 @@ type Constraints m = (HasCallStack, MonadLogger m, MonadUnliftIO m, MonadBaseCon
|
|||
|
||||
-- | Spin up a Selenium WebDriver and create a WebDriver
|
||||
startWebDriver :: (
|
||||
Constraints m, MonadReader context m, HasFile context "java"
|
||||
Constraints m, MonadReader context m
|
||||
, HasFile context "java", HasFile context "selenium.jar", HasBrowserDependencies context
|
||||
) => WdOptions -> FilePath -> m WebDriver
|
||||
startWebDriver wdOptions@(WdOptions {capabilities=capabilities', ..}) runRoot = do
|
||||
startWebDriver wdOptions@(WdOptions {capabilities=capabilities'', ..}) runRoot = do
|
||||
-- Create a unique name for this webdriver so the folder for its log output doesn't conflict with any others
|
||||
webdriverName <- ("webdriver_" <>) <$> liftIO makeUUID
|
||||
|
||||
|
@ -59,26 +61,30 @@ startWebDriver wdOptions@(WdOptions {capabilities=capabilities', ..}) runRoot =
|
|||
let downloadDir = webdriverRoot </> "Downloads"
|
||||
liftIO $ createDirectoryIfMissing True downloadDir
|
||||
|
||||
-- Get selenium and chromedriver
|
||||
debug [i|Preparing to create the Selenium process|]
|
||||
seleniumPath <- obtainSelenium toolsRoot seleniumToUse >>= \case
|
||||
Left err -> error [i|Failed to obtain selenium: '#{err}'|]
|
||||
Right p -> return p
|
||||
driverArgs <- case W.browser capabilities' of
|
||||
W.Firefox {} -> do
|
||||
obtainGeckoDriver toolsRoot geckoDriverToUse >>= \case
|
||||
Left err -> error [i|Failed to obtain geckodriver: '#{err}'|]
|
||||
Right p -> return [[i|-Dwebdriver.gecko.driver=#{p}|]
|
||||
-- , [i|-Dwebdriver.gecko.logfile=#{webdriverRoot </> "geckodriver.log"}|]
|
||||
-- , [i|-Dwebdriver.gecko.verboseLogging=true|]
|
||||
]
|
||||
W.Chrome {} -> do
|
||||
obtainChromeDriver toolsRoot chromeDriverToUse >>= \case
|
||||
Left err -> error [i|Failed to obtain chromedriver: '#{err}'|]
|
||||
Right p -> return [[i|-Dwebdriver.chrome.driver=#{p}|]
|
||||
, [i|-Dwebdriver.chrome.logfile=#{webdriverRoot </> "chromedriver.log"}|]
|
||||
, [i|-Dwebdriver.chrome.verboseLogging=true|]]
|
||||
x -> error [i|Browser #{x} is not supported yet|]
|
||||
-- Get selenium, driver args, and capabilities with browser paths applied
|
||||
java <- askFile @"java"
|
||||
seleniumPath <- askFile @"selenium.jar"
|
||||
(driverArgs, capabilities') <- getContext browserDependencies >>= \case
|
||||
BrowserDependenciesFirefox {..} -> do
|
||||
let args = [
|
||||
[i|-Dwebdriver.gecko.driver=#{browserDependenciesFirefoxGeckodriver}|]
|
||||
-- , [i|-Dwebdriver.gecko.logfile=#{webdriverRoot </> "geckodriver.log"}|]
|
||||
-- , [i|-Dwebdriver.gecko.verboseLogging=true|]
|
||||
]
|
||||
let capabilities' = capabilities'' {
|
||||
W.browser = W.firefox { W.ffBinary = Just browserDependenciesFirefoxFirefox }
|
||||
}
|
||||
return (args, capabilities')
|
||||
BrowserDependenciesChrome {..} -> do
|
||||
let args = [
|
||||
[i|-Dwebdriver.chrome.driver=#{browserDependenciesChromeChromedriver}|]
|
||||
, [i|-Dwebdriver.chrome.logfile=#{webdriverRoot </> "chromedriver.log"}|]
|
||||
, [i|-Dwebdriver.chrome.verboseLogging=true|]
|
||||
]
|
||||
let capabilities' = capabilities'' {
|
||||
W.browser = W.chrome { W.chromeBinary = Just browserDependenciesChromeChrome }
|
||||
}
|
||||
return (args, capabilities')
|
||||
|
||||
(maybeXvfbSession, javaEnv) <- case runMode of
|
||||
#ifndef mingw32_HOST_OS
|
||||
|
@ -93,9 +99,6 @@ startWebDriver wdOptions@(WdOptions {capabilities=capabilities', ..}) runRoot =
|
|||
let webdriverProcessRoot = webdriverRoot </> T.unpack webdriverProcessName
|
||||
liftIO $ createDirectoryIfMissing True webdriverProcessRoot
|
||||
|
||||
java <- askFile @"java"
|
||||
-- seleniumJar <- askFile @"selenium.jar"
|
||||
|
||||
-- Retry up to 10 times
|
||||
-- This is necessary because sometimes we get a race for the port we get from findFreePortOrException.
|
||||
-- There doesn't seem to be any way to make Selenium choose its own port.
|
||||
|
@ -124,17 +127,19 @@ startWebDriver wdOptions@(WdOptions {capabilities=capabilities', ..}) runRoot =
|
|||
|
||||
-- Read from the (combined) output stream until we see the up and running message,
|
||||
-- or the process ends and we get an exception from hGetLine
|
||||
fix $ \loop -> do
|
||||
startupResult <- timeout 10_000_000 $ fix $ \loop -> do
|
||||
line <- fmap T.pack $ liftIO $ hGetLine hRead
|
||||
debug line
|
||||
|
||||
if | "Selenium Server is up and running" `T.isInfixOf` line -> return ()
|
||||
| otherwise -> loop
|
||||
|
||||
return (port, hRead, p)
|
||||
case startupResult of
|
||||
Nothing -> expectationFailure [i|Didn't see "up and running" line in Selenium output.|]
|
||||
Just () -> return (port, hRead, p)
|
||||
|
||||
-- TODO: save this in the WebDriver to tear it down later?
|
||||
logAsync <- forever $ liftIO (hGetLine hRead) >>= (debug . T.pack)
|
||||
_logAsync <- async $ forever (liftIO (hGetLine hRead) >>= (debug . T.pack))
|
||||
|
||||
-- Final extra capabilities configuration
|
||||
capabilities <-
|
||||
|
|
|
@ -55,28 +55,12 @@ data RunMode = Normal
|
|||
-- xvfb-run script must be installed and on the PATH.
|
||||
|
||||
data WdOptions = WdOptions {
|
||||
toolsRoot :: ToolsRoot
|
||||
-- ^ Folder where any necessary binaries (chromedriver, Selenium, etc.) will be downloaded if needed. Required.
|
||||
|
||||
, capabilities :: W.Capabilities
|
||||
capabilities :: W.Capabilities
|
||||
-- ^ The WebDriver capabilities to use.
|
||||
|
||||
, saveSeleniumMessageHistory :: WhenToSave
|
||||
-- ^ When to save a record of Selenium requests and responses.
|
||||
|
||||
, seleniumToUse :: SeleniumToUse
|
||||
-- ^ Which Selenium server JAR file to use.
|
||||
|
||||
, chromeBinaryPath :: Maybe FilePath
|
||||
-- ^ Which chrome binary to use.
|
||||
, chromeDriverToUse :: ChromeDriverToUse
|
||||
-- ^ Which chromedriver executable to use.
|
||||
|
||||
, firefoxBinaryPath :: Maybe FilePath
|
||||
-- ^ Which firefox binary to use.
|
||||
, geckoDriverToUse :: GeckoDriverToUse
|
||||
-- ^ Which geckodriver executable to use.
|
||||
|
||||
, runMode :: RunMode
|
||||
-- ^ How to handle opening the browser (in a popup window, headless, etc.).
|
||||
|
||||
|
@ -103,7 +87,7 @@ data ChromeDriverToUse =
|
|||
-- ^ Download chromedriver from the given URL to the 'toolsRoot'
|
||||
| DownloadChromeDriverVersion ChromeDriverVersion
|
||||
-- ^ Download the given chromedriver version to the 'toolsRoot'
|
||||
| DownloadChromeDriverAutodetect (Maybe FilePath)
|
||||
| DownloadChromeDriverAutodetect FilePath
|
||||
-- ^ Autodetect chromedriver to use based on the Chrome version and download it to the 'toolsRoot'
|
||||
-- Pass the path to the Chrome binary, or else it will be found by looking for google-chrome on the PATH.
|
||||
| UseChromeDriverAt FilePath
|
||||
|
@ -155,16 +139,10 @@ defaultXvfbConfig = XvfbConfig Nothing False
|
|||
|
||||
-- | The default 'WdOptions' object.
|
||||
-- You should start with this and modify it using the accessors.
|
||||
defaultWdOptions :: FilePath -> WdOptions
|
||||
defaultWdOptions toolsRoot = WdOptions {
|
||||
toolsRoot = toolsRoot
|
||||
, capabilities = def
|
||||
defaultWdOptions :: WdOptions
|
||||
defaultWdOptions = WdOptions {
|
||||
capabilities = def
|
||||
, saveSeleniumMessageHistory = OnException
|
||||
, seleniumToUse = DownloadSeleniumDefault
|
||||
, chromeBinaryPath = Nothing
|
||||
, chromeDriverToUse = DownloadChromeDriverAutodetect Nothing
|
||||
, firefoxBinaryPath = Nothing
|
||||
, geckoDriverToUse = DownloadGeckoDriverAutodetect Nothing
|
||||
, runMode = Normal
|
||||
, httpManager = Nothing
|
||||
, httpRetryCount = 0
|
||||
|
@ -270,3 +248,18 @@ defaultVideoSettings = VideoSettings {
|
|||
, hideMouseWhenRecording = False
|
||||
, logToDisk = True
|
||||
}
|
||||
|
||||
data BrowserDependencies = BrowserDependenciesChrome {
|
||||
browserDependenciesChromeChrome :: FilePath
|
||||
, browserDependenciesChromeChromedriver :: FilePath
|
||||
}
|
||||
| BrowserDependenciesFirefox {
|
||||
browserDependenciesFirefoxFirefox :: FilePath
|
||||
, browserDependenciesFirefoxGeckodriver :: FilePath
|
||||
}
|
||||
deriving (Show)
|
||||
|
||||
browserDependencies :: Label "browserDependencies" BrowserDependencies
|
||||
browserDependencies = Label
|
||||
|
||||
type HasBrowserDependencies context = HasLabel context "browserDependencies" BrowserDependencies
|
||||
|
|
|
@ -155,16 +155,21 @@ runSandwichWithCommandLineArgs' baseOptions userOptionsParser spec = do
|
|||
updateGolden (optGoldenDir (optGoldenOptions clo))
|
||||
| otherwise -> do
|
||||
-- Awkward, but we need a specific context type to call countItNodes
|
||||
let totalTests = countItNodes (spec :: SpecFree (LabelValue "commandLineOptions" (CommandLineOptions a) :> BaseContext) IO ())
|
||||
let totalTests = countItNodes (spec :: SpecFree (LabelValue "someCommandLineOptions" SomeCommandLineOptions :> LabelValue "commandLineOptions" (CommandLineOptions a) :> BaseContext) IO ())
|
||||
|
||||
let cliNodeOptions = defaultNodeOptions { nodeOptionsVisibilityThreshold = systemVisibilityThreshold
|
||||
, nodeOptionsCreateFolder = False }
|
||||
|
||||
runWithRepeat repeatCount totalTests $
|
||||
case optIndividualTestModule clo of
|
||||
Nothing -> runSandwich' (Just $ clo { optUserOptions = () }) options $
|
||||
introduce' (defaultNodeOptions { nodeOptionsVisibilityThreshold = systemVisibilityThreshold
|
||||
, nodeOptionsCreateFolder = False }) "command line options" commandLineOptions (pure clo) (const $ return ()) spec
|
||||
introduce' cliNodeOptions "some command line options" someCommandLineOptions (pure (SomeCommandLineOptions clo)) (const $ return ())
|
||||
$ introduce' cliNodeOptions "command line options" commandLineOptions (pure clo) (const $ return ())
|
||||
$ spec
|
||||
Just (IndividualTestModuleName x) -> runSandwich' (Just $ clo { optUserOptions = () }) options $ filterTreeToModule x $
|
||||
introduce' (defaultNodeOptions { nodeOptionsVisibilityThreshold = systemVisibilityThreshold
|
||||
, nodeOptionsCreateFolder = False }) "command line options" commandLineOptions (pure clo) (const $ return ()) spec
|
||||
introduce' cliNodeOptions "some command line options" someCommandLineOptions (pure (SomeCommandLineOptions clo)) (const $ return ())
|
||||
$ introduce' cliNodeOptions "command line options" commandLineOptions (pure clo) (const $ return ())
|
||||
$ spec
|
||||
Just (IndividualTestMainFn x) -> do
|
||||
let individualTestFlagStrings = [[ Just ("--" <> shorthand), const ("--" <> shorthand <> "-main") <$> nodeModuleInfoFn ]
|
||||
| (NodeModuleInfo {..}, shorthand) <- modulesAndShorthands]
|
||||
|
|
|
@ -202,7 +202,7 @@ parseCommandLineArgs' :: forall a. Typeable a => Parser a -> TopSpecWithOptions'
|
|||
, [(NodeModuleInfo, T.Text)]
|
||||
)
|
||||
parseCommandLineArgs' userOptionsParser spec = do
|
||||
let modulesAndShorthands = gatherMainFunctions (spec :: SpecFree (LabelValue "commandLineOptions" (CommandLineOptions a) :> BaseContext) IO ())
|
||||
let modulesAndShorthands = gatherMainFunctions (spec :: SpecFree (LabelValue "someCommandLineOptions" SomeCommandLineOptions :> LabelValue "commandLineOptions" (CommandLineOptions a) :> BaseContext) IO ())
|
||||
& L.sortOn nodeModuleInfoModuleName
|
||||
& gatherShorthands
|
||||
let individualTestFlags maybeInternal =
|
||||
|
|
|
@ -38,6 +38,12 @@ getCurrentFolder = asks (baseContextPath . getBaseContext)
|
|||
getCommandLineOptions :: forall a context m. (HasCommandLineOptions context a, MonadReader context m) => m (CommandLineOptions a)
|
||||
getCommandLineOptions = getContext commandLineOptions
|
||||
|
||||
-- | Get existentially wrapped command line options, if configured.
|
||||
-- Using the 'runSandwichWithCommandLineArgs' family of main functions will introduce these, or you can
|
||||
-- introduce them manually
|
||||
getSomeCommandLineOptions :: forall context m. (HasSomeCommandLineOptions context, MonadReader context m) => m SomeCommandLineOptions
|
||||
getSomeCommandLineOptions = getContext someCommandLineOptions
|
||||
|
||||
-- | Get the user command line options, if configured.
|
||||
-- This just calls 'getCommandLineOptions' and pulls out the user options.
|
||||
getUserCommandLineOptions :: (HasCommandLineOptions context a, MonadReader context m) => m a
|
||||
|
|
|
@ -37,6 +37,8 @@ module Test.Sandwich.Misc (
|
|||
, HasBaseContext
|
||||
, HasBaseContextMonad
|
||||
, HasCommandLineOptions
|
||||
, SomeCommandLineOptions(..)
|
||||
, HasSomeCommandLineOptions
|
||||
|
||||
-- * Result types
|
||||
, Result(..)
|
||||
|
|
|
@ -168,16 +168,25 @@ commandLineOptions = Label :: Label "commandLineOptions" (CommandLineOptions a)
|
|||
-- | Has-* class for asserting a 'CommandLineOptions a' is available.
|
||||
type HasCommandLineOptions context a = HasLabel context "commandLineOptions" (CommandLineOptions a)
|
||||
|
||||
-- | Existential wrapper for 'CommandLineOptions a'.
|
||||
someCommandLineOptions :: Label "someCommandLineOptions" SomeCommandLineOptions
|
||||
someCommandLineOptions = Label :: Label "someCommandLineOptions" SomeCommandLineOptions
|
||||
data SomeCommandLineOptions where
|
||||
SomeCommandLineOptions :: CommandLineOptions a -> SomeCommandLineOptions
|
||||
type HasSomeCommandLineOptions context = HasLabel context "someCommandLineOptions" SomeCommandLineOptions
|
||||
|
||||
type TopSpecWithOptions = forall context. (
|
||||
Typeable context
|
||||
, HasBaseContext context
|
||||
, HasCommandLineOptions context ()
|
||||
, HasSomeCommandLineOptions context
|
||||
) => SpecFree context IO ()
|
||||
|
||||
type TopSpecWithOptions' a = forall context. (
|
||||
Typeable context
|
||||
, HasBaseContext context
|
||||
, HasCommandLineOptions context a
|
||||
, HasSomeCommandLineOptions context
|
||||
) => SpecFree context IO ()
|
||||
|
||||
-- * Formatter
|
||||
|
|
Loading…
Reference in New Issue
Block a user