packages feed

webdriver 0.14.0.0 → 0.15.0.0

raw patch · 14 files changed

+662/−177 lines, 14 files

Files

CHANGELOG.md view
@@ -1,5 +1,12 @@ # Change Log +## 0.15.0.0+* Add `Test.WebDriver.Commands.BiDi.NetworkActivity` with tools for working with browser network activity.+* Add support for starting BiDi sessions and watching events.+* Add `_firefoxOptionsEnv` to set Firefox environment variables. Useful to pass MOZ_ENABLE_WAYLAND=0 to make window positioning work better.+* Fix some missed teardown of geckodriver processes.+* Add flags to pass environment variables to drivers.+ ## 0.14.0.0 * Fix MVar bug in teardownWebDriverContext. * Make driverConfigLogDir optional (#206).
app/Main.hs view
@@ -27,6 +27,7 @@   let driverConfig = DriverConfigChromedriver {         driverConfigChromedriver = chromedriverBin         , driverConfigChromedriverFlags = []+        , driverConfigChromedriverExtraEnv = Nothing         , driverConfigChrome = chromeBin         , driverConfigLogDir = Nothing         }
src/Test/WebDriver.hs view
@@ -94,6 +94,7 @@ import Network.HTTP.Types (RequestHeaders, statusCode) import UnliftIO.Concurrent import UnliftIO.Exception+import UnliftIO.STM   -- | Start a WebDriver session, with a given 'WebDriverContext' and@@ -148,11 +149,14 @@                    A.Object (aesonLookup "capabilities" -> Just (A.Object (aesonLookup "webSocketUrl" -> Just (A.String url)))) -> Just url                    _ -> Nothing +             idCounterVar <- newTVarIO 1+              return $ Session {                sessionDriver = driver                , sessionId = SessionId sessId                , sessionName = sessionName                , sessionWebSocketUrl = T.unpack <$> maybeWebSocketUrl+               , sessionIdCounter = idCounterVar                }            _ -> throwIO $ SessionCreationResponseHadNoSessionId response      | otherwise -> throwIO SessionNameAlreadyExists@@ -162,18 +166,20 @@ -- process if necessary. closeSession :: (WebDriverBase m, MonadLogger m) => WebDriverContext -> Session -> m () closeSession wdc sess@(Session {..}) = do-  closeSession' sess--  modifyMVar_ (_webDriverSessions wdc) (return . M.delete sessionName)+  -- For geckodriver, we own the process (one per session), so we must always+  -- tear it down -- even if the HTTP DELETE to close the session fails.+  let teardownGecko = case _driverConfig sessionDriver of+        DriverConfigGeckodriver {} -> teardownDriver sessionDriver+        _ -> return () -  case _driverConfig sessionDriver of-    DriverConfigGeckodriver {} -> teardownDriver sessionDriver-    _ -> return ()+  flip finally teardownGecko $ do+    closeSession' sess+    modifyMVar_ (_webDriverSessions wdc) (return . M.delete sessionName)  -- | Close the given WebDriver session. This is a lower-level version of -- 'closeSession', which manages the driver lifecycle for you. This version will -- only issue the @DELETE \/session\/:sessionId@ command to the driver, but will--- not shut driver processes.+-- not shut down driver processes. closeSession' :: (WebDriverBase m, MonadLogger m) => Session -> m () closeSession' (Session { sessionId=(SessionId sessId), .. }) = do   _response <- doCommandBase sessionDriver methodDelete ("/session/" <> sessId) Null@@ -202,16 +208,27 @@     , _driverManager = manager     , _driverProcess = Nothing     , _driverLogAsync = Nothing-    , _driverConfig = DriverConfigChromedriver "" [] "" Nothing -- Not used+    , _driverConfig = DriverConfigChromedriver "" [] Nothing "" Nothing -- Not used     }  -- | Tear down all sessions and processes associated with a 'WebDriverContext'. teardownWebDriverContext :: (WebDriverBase m, MonadLogger m) => WebDriverContext -> m () teardownWebDriverContext (WebDriverContext {..}) = do-  modifyMVar_ _webDriverSessions $ \sessions -> do-    forM_ [sess | (_, sess) <- M.toList sessions] $ \sess ->-      closeSession' sess-    return mempty+  -- Atomically take all sessions and clear the map, so we can clean up each+  -- one without holding the MVar (and without modifyMVar_ restoring the old+  -- value if any individual cleanup throws).+  sessions <- modifyMVar _webDriverSessions $ \s -> return (mempty, M.toList s)++  forM_ sessions $ \(_name, sess) -> do+    catch (closeSession' sess)+          (\(e :: SomeException) -> logWarnN [i|Exception closing session during teardown: #{e}|])+    -- Geckodriver runs one process per session; tear it down here since+    -- closeSession' only sends the HTTP DELETE and doesn't manage processes.+    case _driverConfig (sessionDriver sess) of+      DriverConfigGeckodriver {} ->+        catch (teardownDriver (sessionDriver sess))+              (\(e :: SomeException) -> logWarnN [i|Exception tearing down geckodriver during teardown: #{e}|])+      _ -> return ()    modifyMVar_ _webDriverSelenium $ \case     Nothing -> return Nothing
src/Test/WebDriver/Capabilities.hs view
@@ -98,11 +98,12 @@   , defaultFirefoxOptions    -- ** Lenses-  , firefoxOptionsProfile-  , firefoxOptionsPrefs-  , firefoxOptionsLog   , firefoxOptionsBinary   , firefoxOptionsArgs+  , firefoxOptionsProfile+  , firefoxOptionsLog+  , firefoxOptionsPrefs+  , firefoxOptionsEnv    -- ** Log level   , FirefoxLogLevel(..)
src/Test/WebDriver/Capabilities/FirefoxOptions.hs view
@@ -4,6 +4,7 @@  import Data.Aeson as A import Data.Aeson.TH+import Data.Map (Map) import Lens.Micro.TH import Test.WebDriver.Capabilities.Aeson import Test.WebDriver.Profile@@ -31,24 +32,42 @@ -- | See https://developer.mozilla.org/en-US/docs/Web/WebDriver/Capabilities/firefoxOptions data FirefoxOptions = FirefoxOptions {   -- | Absolute path to the custom Firefox binary to use.-  -- On macOS you may either give the path to the application bundle, i.e. @\/Applications\/Firefox.app@, or the absolute-  -- path to the executable binary inside this bundle, for example-  -- @\/Applications\/Firefox.app\/Contents\/MacOS\/firefox-bin@. geckodriver will attempt to deduce the default location of-  -- Firefox on the current system if left undefined.+  --+  -- On macOS you may either give the path to the application bundle, i.e.+  -- @\/Applications\/Firefox.app@, or the absolute path to the executable+  -- binary inside this bundle, for example+  -- @\/Applications\/Firefox.app\/Contents\/MacOS\/firefox-bin@.+  --+  -- geckodriver will attempt to deduce the default location of Firefox on the+  -- current system if left undefined.   _firefoxOptionsBinary :: Maybe String-  -- | Command line arguments to pass to the Firefox binary.-  -- These must include the leading dash (-) where required, e.g. ["-headless"].-  -- To have geckodriver pick up an existing profile on the local filesystem, you may pass @["-profile", -- "\/path\/to\/profile"]@.-  -- But if a profile has to be transferred to a target machine it is recommended to use the profile entry.+  -- | Command line arguments to pass to the Firefox binary. These must include+  -- the leading dash (-) where required, e.g. ["-headless"].+  --+  -- To have geckodriver pick up an existing profile on the local filesystem,+  -- you may pass @["-profile", -- "\/path\/to\/profile"]@. But if a profile has+  -- to be transferred to a target machine it is recommended to use the profile+  -- entry.   , _firefoxOptionsArgs :: Maybe [String]-  -- | Base64-encoded ZIP of a profile directory to use for the Firefox instance. This may be used to e.g. install-  -- extensions or custom certificates, but for setting custom preferences we recommend using the prefs entry instead.+  -- | Base64-encoded ZIP of a profile directory to use for the Firefox+  -- instance. This may be used to e.g. install extensions or custom+  -- certificates, but for setting custom preferences we recommend using the+  -- prefs entry instead.   , _firefoxOptionsProfile :: Maybe (Profile Firefox)-  -- | To increase the logging verbosity of geckodriver and Firefox, you may pass a log object that may look like-  -- {"log": {"level": "trace"}} to include all trace-level logs and above.+  -- | To increase the logging verbosity of geckodriver and Firefox, you may+  -- pass a log object that may look like {"log": {"level": "trace"}} to include+  -- all trace-level logs and above.   , _firefoxOptionsLog :: Maybe FirefoxLogLevel-  -- | Map of preference name to preference value, which can be a string, a boolean or an integer.+  -- | Map of preference name to preference value, which can be a string, a+  -- boolean or an integer.   , _firefoxOptionsPrefs :: Maybe A.Object+  -- | Map of environment variable name to environment variable value, both of+  -- which must be strings.+  --+  -- On Desktop, the Firefox under test will launch with given variable in its+  -- environment. On Android, the GeckoView-based App will have the given+  -- variable added to the env block in its configuration YAML.+  , _firefoxOptionsEnv :: Maybe (Map String String)    -- TODO: Android options   }@@ -63,6 +82,7 @@   , _firefoxOptionsProfile = Nothing   , _firefoxOptionsLog = Nothing   , _firefoxOptionsPrefs = Nothing+  , _firefoxOptionsEnv = Nothing   }  -- | Empty 'FirefoxOptions'.
src/Test/WebDriver/Commands.hs view
@@ -83,6 +83,14 @@   -- | Retrieve browser console logs and other log types.   , module Test.WebDriver.Commands.Logs +  -- * BiDi sessions (experimental)+  -- | Low-level BiDi session establishment.+  , module Test.WebDriver.Commands.BiDi.Session++  -- * Network activity (experimental)+  -- | Use BiDi to track network activity events.+  , module Test.WebDriver.Commands.BiDi.NetworkActivity+   -- * Selenium-specific   -- ** Mobile device support   , module Test.WebDriver.Commands.SeleniumSpecific.Mobile@@ -98,6 +106,8 @@   ) where  import Test.WebDriver.Commands.Actions+import Test.WebDriver.Commands.BiDi.NetworkActivity+import Test.WebDriver.Commands.BiDi.Session import Test.WebDriver.Commands.CommandContexts import Test.WebDriver.Commands.Cookies import Test.WebDriver.Commands.DocumentHandling
+ src/Test/WebDriver/Commands/BiDi/NetworkActivity.hs view
@@ -0,0 +1,312 @@+{-# LANGUAGE StrictData #-}+{-# LANGUAGE MultiWayIf #-}++module Test.WebDriver.Commands.BiDi.NetworkActivity (+  withRecordNetworkActivityViaBiDi+  , withRecordNetworkActivityViaBiDi'++  , readNetworkActivity+  , waitForNetworkIdle+  , waitForNetworkIdleForPeriod+  , withWaitForNetworkIdleForPeriod++  -- * Types+  , RequestInfo+  , requestInfoRequestId+  , requestInfoMethod+  , requestInfoUrl+  , requestInfoTimestamp+  , requestInfoRequestHeaders+  , requestInfoResponseHeaders+  , requestInfoResponseText+  , requestInfoErrorText+  , requestInfoCompleted+  , RequestId+  ) where++import Control.Applicative ((<|>))+import Control.Concurrent.STM (retry)+import Control.Monad (unless)+import Control.Monad.IO.Unlift+import Control.Monad.Logger (MonadLogger, logDebugN, logWarnN)+import Data.Aeson+import Data.Aeson.Types (parseEither, Parser)+import Data.Foldable (toList)+import Data.Map (Map)+import qualified Data.Map as M+import Data.String.Interpolate+import Data.Text (Text)+import Data.Time+import Data.Time.Clock.POSIX (posixSecondsToUTCTime)+import qualified Network.URI as URI+import Test.WebDriver.Commands.BiDi.Session+import Test.WebDriver.Types+import UnliftIO.Concurrent+import UnliftIO.STM+++networkEvents :: [Text]+networkEvents = [+  "network.beforeRequestSent"+  , "network.responseCompleted"+  , "network.responseStarted"+  , "network.fetchError"+  ]++type RequestId = Text++data RequestInfo = RequestInfo {+  requestInfoRequestId :: RequestId+  , requestInfoMethod :: Text+  , requestInfoUrl :: Text+  , requestInfoTimestamp :: UTCTime+  , requestInfoRequestHeaders :: Maybe (Map Text Text)+  , requestInfoResponseHeaders :: Maybe (Map Text Text)+  , requestInfoResponseStatus :: Maybe Int+  , requestInfoResponseText :: Maybe Text+  , requestInfoErrorText :: Maybe Text+  , requestInfoCompleted :: Bool+  } deriving (Show, Eq)++data NetworkActivity = NetworkActivity {+  networkActivityRequests :: Map RequestId RequestInfo+  , networkActivityLastActivityTime :: UTCTime+  } deriving (Eq)++type NetworkActivityVar = TVar NetworkActivity++-- | Wrapper around 'withRecordNetworkActivityViaBiDi'' which uses the WebSocket URL from+-- the current 'Session'. You must make sure to pass '_capabilitiesWebSocketUrl'+-- = @Just True@ to enable this. This will not work with Selenium 3.+withRecordNetworkActivityViaBiDi :: (WebDriver m, MonadLogger m) => BiDiOptions -> (NetworkActivityVar -> m a) -> m a+withRecordNetworkActivityViaBiDi biDiOptions action = do+  networkActivityVar <- newNetworkActivityVar+  withBiDiSession biDiOptions networkEvents (mkCallback networkActivityVar) (action networkActivityVar)++-- | Connect to WebSocket URL and subscribe to network events using the W3C BiDi protocol; see+-- <https://w3c.github.io/webdriver-bidi/>.+withRecordNetworkActivityViaBiDi' :: forall m a. (MonadUnliftIO m, MonadLogger m) => BiDiOptions -> Int -> URI.URI -> (NetworkActivityVar -> m a) -> m a+withRecordNetworkActivityViaBiDi' biDiOptions bidiSessionId uri action = do+  networkActivityVar <- newNetworkActivityVar+  withBiDiSession' biDiOptions bidiSessionId uri networkEvents (mkCallback networkActivityVar) (action networkActivityVar)++mkCallback :: (MonadIO m, MonadLogger m) => NetworkActivityVar -> BiDiEvent -> m ()+mkCallback nav (BiDiEvent "event" "network.beforeRequestSent" params) = do+  case parseBeforeRequestSent params of+    Just (requestId, method, url, timestamp, headers) -> do+      now <- liftIO getCurrentTime+      atomically $ modifyTVar nav $ \na -> na {+        networkActivityRequests = M.insert requestId (RequestInfo {+          requestInfoRequestId = requestId+          , requestInfoMethod = method+          , requestInfoUrl = url+          , requestInfoTimestamp = timestamp+          , requestInfoRequestHeaders = headers+          , requestInfoResponseHeaders = Nothing+          , requestInfoResponseStatus = Nothing+          , requestInfoResponseText = Nothing+          , requestInfoErrorText = Nothing+          , requestInfoCompleted = False+          }) (networkActivityRequests na)+        , networkActivityLastActivityTime = now+        }+      logDebugN [i|BiDi: Network request started: #{requestId} #{method} #{url}|]+    Nothing -> logWarnN "BiDi: Failed to parse network.beforeRequestSent event"++mkCallback nav (BiDiEvent "event" "network.responseStarted" params) = do+  case parseResponseStarted params of+    Just (requestId, status, headers) -> do+      now <- liftIO getCurrentTime+      maybeRequestInfo <- atomically $ do+        na <- readTVar nav++        let (ret, requests') = adjustAndReturnNew requestId (networkActivityRequests na) $ \ri -> ri {+              requestInfoResponseStatus = Just status+              , requestInfoResponseHeaders = headers+              }++        modifyTVar nav $ \na' -> na' {+          networkActivityRequests = requests'+          , networkActivityLastActivityTime = now+          }++        return ret+      logDebugN [i|BiDi: Network response started: #{requestId} status #{status} (#{maybe "<unknown>" requestInfoUrl maybeRequestInfo})|]+    Nothing -> logWarnN "BiDi: Failed to parse network.responseStarted event"++mkCallback nav (BiDiEvent "event" "network.responseCompleted" params) = do+  case parseResponseCompleted params of+    Just (requestId, responseText) -> do+      now <- liftIO getCurrentTime+      maybeRequestInfo <- atomically $ do+        na <- readTVar nav++        let (ret, requests') = adjustAndReturnNew requestId (networkActivityRequests na) $ \ri -> ri {+              requestInfoResponseText = responseText+              , requestInfoCompleted = True+              }++        modifyTVar nav $ \na' -> na' {+          networkActivityRequests = requests'+          , networkActivityLastActivityTime = now+          }++        return ret++      logDebugN [i|BiDi: Network response completed: #{requestId} (#{maybe "<unknown>" requestInfoUrl maybeRequestInfo})|]+    Nothing -> logWarnN "BiDi: Failed to parse network.responseCompleted event"++mkCallback nav (BiDiEvent "event" "network.fetchError" params) = do+  case parseFetchError params of+    Just (requestId, errorText) -> do+      now <- liftIO getCurrentTime+      maybeRequestInfo <- atomically $ do+        na <- readTVar nav++        let (ret, requests') = adjustAndReturnNew requestId (networkActivityRequests na) $ \ri -> ri {+              requestInfoErrorText = Just errorText+              , requestInfoCompleted = True+              }++        modifyTVar nav $ \na' -> na' {+          networkActivityRequests = requests'+          , networkActivityLastActivityTime = now+          }++        return ret++      logDebugN [i|BiDi: Network fetch error: #{requestId} - #{errorText} (#{maybe "<unknown>" requestInfoUrl maybeRequestInfo})|]+    Nothing -> logWarnN "BiDi: Failed to parse network.fetchError event"++mkCallback _nav x = logDebugN [i|BiDi: Ignoring event: #{x}|]++parseBeforeRequestSent :: Value -> Maybe (RequestId, Text, Text, UTCTime, Maybe (Map Text Text))+parseBeforeRequestSent (Object o) = case parseEither parseRequest o of+  Right result -> Just result+  Left _ -> Nothing+  where+    parseRequest o' = do+      request <- o' .: "request"+      requestId <- request .: "request"  -- The requestId is in request.request+      method <- request .: "method"+      url <- request .: "url"+      timestamp <- o' .: "timestamp" :: Parser Integer+      headers <- optional (request .: "headers") >>= \case+        Just headerList -> Just <$> parseHeaders headerList+        Nothing -> pure Nothing+      let utcTime = posixSecondsToUTCTime (realToFrac timestamp / 1000)+      pure (requestId, method, url, utcTime, headers)+parseBeforeRequestSent _ = Nothing++parseResponseStarted :: Value -> Maybe (RequestId, Int, Maybe (Map Text Text))+parseResponseStarted (Object o) = case parseEither parseResponse o of+  Right result -> Just result+  Left _ -> Nothing+  where+    parseResponse o' = do+      request <- o' .: "request"+      requestId <- request .: "request"  -- The requestId is in request.request+      response <- o' .: "response"+      status <- response .: "status"+      headers <- optional (response .: "headers") >>= \case+        Just headerList -> Just <$> parseHeaders headerList+        Nothing -> pure Nothing+      pure (requestId, status, headers)+parseResponseStarted _ = Nothing++parseResponseCompleted :: Value -> Maybe (RequestId, Maybe Text)+parseResponseCompleted (Object o) = case parseEither parseResponse o of+  Right result -> Just result+  Left _ -> Nothing+  where+    parseResponse o' = do+      request <- o' .: "request"+      requestId <- request .: "request"  -- The requestId is in request.request+      responseText <- optional (o' .: "response" >>= (.: "body") >>= (.: "value"))+      pure (requestId, responseText)+parseResponseCompleted _ = Nothing++parseFetchError :: Value -> Maybe (RequestId, Text)+parseFetchError (Object o) = case parseEither parseError o of+  Right result -> Just result+  Left _ -> Nothing+  where+    parseError o' = do+      request <- o' .: "request"+      requestId <- request .: "request"  -- The requestId is in request.request+      errorText <- o' .: "errorText"+      pure (requestId, errorText)+parseFetchError _ = Nothing++parseHeaders :: Value -> Parser (Map Text Text)+parseHeaders (Array headers) = do+  headerPairs <- mapM parseHeader (toList headers)+  pure $ M.fromList headerPairs+  where+    parseHeader (Object h) = do+      name <- h .: "name"+      valueObj <- h .: "value"+      value <- case valueObj of+        Object vo -> vo .: "value"  -- Extract value from {type: "string", value: "..."}+        String s -> pure s          -- Fallback for direct string values+        _ -> fail "Invalid header value format"+      pure (name, value)+    parseHeader _ = fail "Invalid header format"+parseHeaders _ = fail "Headers should be an array"++optional :: Parser a -> Parser (Maybe a)+optional p = (Just <$> p) <|> pure Nothing++newNetworkActivityVar :: MonadIO m => m NetworkActivityVar+newNetworkActivityVar = do+  now <- liftIO getCurrentTime+  newTVarIO $ NetworkActivity M.empty now++-- | Read the current network activity map.+readNetworkActivity :: MonadIO m => NetworkActivityVar -> m (Map RequestId RequestInfo)+readNetworkActivity nav = networkActivityRequests <$> readTVarIO nav++-- | Wait for network to be idle (no pending requests).+waitForNetworkIdle :: MonadIO m => NetworkActivityVar -> m ()+waitForNetworkIdle nav = atomically $ do+  na <- readTVar nav+  let pending = filter (not . requestInfoCompleted) (M.elems (networkActivityRequests na))+  unless (null pending) retry++-- | Wait for network to be idle with a delay after the last activity+-- This waits until:+--+-- 1. There are no outstanding requests AND+-- 2. No request has started or finished in the last time period given by the 'NominalDiffTime'.+waitForNetworkIdleForPeriod :: MonadIO m => NetworkActivityVar -> NominalDiffTime -> m ()+waitForNetworkIdleForPeriod nav idleTime = do+  lastActivityTime <- atomically $ do+    na <- readTVar nav+    let pending = filter (not . requestInfoCompleted) (M.elems (networkActivityRequests na))+    unless (null pending) retry++    return (networkActivityLastActivityTime na)++  now <- liftIO getCurrentTime+  let timeSinceLastActivity = diffUTCTime now lastActivityTime+  if | timeSinceLastActivity >= idleTime ->+         return ()+     | otherwise -> do+         threadDelay $ nominalDiffTimeToMicroseconds (idleTime - timeSinceLastActivity)+         waitForNetworkIdleForPeriod nav idleTime+  where+    nominalDiffTimeToMicroseconds :: NominalDiffTime -> Int+    nominalDiffTimeToMicroseconds t = round (t * 1000000)++withWaitForNetworkIdleForPeriod :: (WebDriver m, MonadLogger m) => BiDiOptions -> NominalDiffTime -> m a -> m a+withWaitForNetworkIdleForPeriod biDiOptions dt action  = do+  withRecordNetworkActivityViaBiDi biDiOptions $ \nav -> do+    ret <- action+    waitForNetworkIdleForPeriod nav dt+    return ret++adjustAndReturnNew :: Ord k => k -> M.Map k a -> (a -> a) -> (Maybe a, M.Map k a)+adjustAndReturnNew k m f = M.alterF alter k m+  where+    alter Nothing = (Nothing, Nothing)+    alter (Just v) = let v' = f v in (Just v', Just v')
+ src/Test/WebDriver/Commands/BiDi/Session.hs view
@@ -0,0 +1,193 @@+{-# LANGUAGE NumericUnderscores #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ViewPatterns #-}++module Test.WebDriver.Commands.BiDi.Session (+  withBiDiSession+  , withBiDiSession'++  , BiDiEvent(..)+  , BiDiResponse(..)++  , BiDiOptions(..)+  , defaultBiDiOptions+  ) where++import Control.Monad (forever)+import Control.Monad.Fix (fix)+import Control.Monad.IO.Unlift+import Control.Monad.Logger (MonadLogger, logDebugN, logErrorN)+import Data.Aeson+import Data.Aeson.TH+import qualified Data.List as L+import Data.String.Interpolate+import Data.Text (Text)+import qualified Network.URI as URI+import qualified Network.WebSockets as WS+import Test.WebDriver.Capabilities.Aeson+import Test.WebDriver.Types+import Text.Read (readMaybe)+import UnliftIO.Async (withAsync)+import UnliftIO.Exception+import UnliftIO.STM (atomically, stateTVar)+import UnliftIO.Timeout (timeout)+++data BiDiEvent = BiDiEvent {+  biDiType :: Text+  , biDiMethod :: Text+  , biDiParams :: Value+  } deriving Show+deriveFromJSON toCamel2 ''BiDiEvent++data BiDiResponse = BiDiResponse {+  biDiResponseType :: Text+  , biDiResponseId :: Int+  , biDiResponseResult :: Maybe Value+  , biDiResponseError :: Maybe Value+  } deriving Show+deriveFromJSON toCamel3 ''BiDiResponse++-- | Options controlling BiDi session establishment.+data BiDiOptions = BiDiOptions {+  biDiSubscriptionRequestTimeoutUs :: Int+  }+-- | Default BiDi options.+defaultBiDiOptions :: BiDiOptions+defaultBiDiOptions = BiDiOptions {+  biDiSubscriptionRequestTimeoutUs = 15_000_000+  }++-- | Wrapper around 'withBiDiSession'' which uses the WebSocket URL from+-- the current 'Session'. You must make sure to pass '_capabilitiesWebSocketUrl'+-- = @Just True@ to enable this. This will not work with Selenium 3.+withBiDiSession :: (WebDriver m, MonadLogger m) => BiDiOptions -> [Text] -> (BiDiEvent -> m ()) -> m a -> m a+withBiDiSession biDiOptions events cb action = do+  Session {..} <- getSession+  webSocketUrl <- case sessionWebSocketUrl of+    Nothing -> throwIO $ userError [i|Session wasn't configured with a BiDi WebSocket URL when trying to record logs. Make sure to enable _capabilitiesWebSocketUrl.|]+    Just x -> pure x++  uri <- case URI.parseURI webSocketUrl of+    Just x -> pure x+    Nothing -> throwIO $ userError [i|Couldn't parse WebSocket URL: #{webSocketUrl}|]++  bidiSessionId <- atomically $ stateTVar sessionIdCounter (\x -> (x, x + 1))++  withBiDiSession' biDiOptions bidiSessionId uri events cb action++-- | Connect to WebSocket URL and subscribe to the given events using the W3C BiDi protocol; see+-- <https://w3c.github.io/webdriver-bidi/>.+withBiDiSession' :: (MonadUnliftIO m, MonadLogger m) => BiDiOptions -> Int -> URI.URI -> [Text] -> (BiDiEvent -> m ()) -> m a -> m a+withBiDiSession' biDiOptions bidiSessionId uri@(URI.URI { uriAuthority=(Just (URI.URIAuth {uriPort=(readMaybe . L.drop 1 -> Just (port :: Int)), ..})), .. }) events cb action = do+  logDebugN [i|BiDi: Connecting to #{uriRegName}:#{port}#{uriPath}|]++  withRunInIO $ \runInIO -> liftIO $ WS.runClient uriRegName port uriPath $ \conn -> runInIO $ do+    logDebugN [i|BiDi: Connected successfully, sending subscription request with ID #{bidiSessionId}|]+    liftIO $ WS.sendTextData conn $ encode $ object [+      "id" .= bidiSessionId+      , "method" .= ("session.subscribe" :: Text)+      , "params" .= object [+          "events" .= (events :: [Text])+        ]+      ]++    logDebugN "BiDi: Sent subscription request, waiting for response..."+    timeout (biDiSubscriptionRequestTimeoutUs biDiOptions) (waitForSubscriptionResult bidiSessionId conn) >>= \case+      Nothing -> throwIO $ userError "BiDi: Subscription response timed out"+      Just (Left err) ->+        throwIO $ userError [i|BiDi: got exception (URI #{uri}): #{err}|]+      Just (Right ()) -> do+        logDebugN "BiDi: Starting log event listener"+        withAsync (messageListener conn) $ \_messageListenerAsy -> do+          finally action $ do+            logDebugN [i|BiDi: finished wrapped action|]+            liftIO $ WS.sendClose conn ([i|Finishing session #{bidiSessionId}|] :: Text)+  where+    messageListener conn =+      forever $+        (decode <$>) (liftIO $ WS.receiveData conn) >>= \case+          Just (x :: BiDiEvent) -> cb x+          x -> logDebugN [i|BiDi: Ignoring non-log event message: #{x}|]+withBiDiSession' _ _ uri _events _cb _action =+  throwIO $ userError [i|WebSocket URL didn't contain an authority: #{uri}|]+++waitForSubscriptionResult :: (+  MonadIO m, MonadLogger m+  ) => Int -> WS.Connection -> m (Either SomeException ())+waitForSubscriptionResult bidiSessionId conn = fix $ \loop -> do+  msg <- liftIO $ WS.receiveData conn+  logDebugN [i|BiDi: Waiting for subscription response: #{msg}|]+  case decode msg of+    Just response@(BiDiResponse responseType responseId _ _)+      | responseType == "success" && responseId == bidiSessionId -> do+          logDebugN "BiDi: Subscription successful!"+          return $ Right ()+      | responseType == "error" && responseId == bidiSessionId -> do+          let errMsg = "BiDi subscription failed: " ++ show response+          logErrorN [i|BiDi: #{errMsg}|]+          return $ Left (toException (userError errMsg))+      | otherwise -> do+          logDebugN [i|BiDi: Ignoring response with type #{responseType}, ID #{responseId}|]+          loop+    Nothing -> do+      logDebugN [i|BiDi: Not a BiDiResponse, continuing to wait for subscription response (#{msg})|]+      loop++-- * Better WebSocket ping/pong+-- | I've run into problems with the ping/pong support in the websockets+-- library, so I came up with this alternative version that I use in my+-- websockets projects.+--+-- But, according to some searching, it seems that the BiDi client doesn't need+-- to do ping/pong, as we can count on the browser driver to do it. So leaving+-- this unused for now. It might still be useful to use at some point to catch+-- dead drivers etc.++-- data BetterPongTimeout =+--   BetterPongTimeoutUnexpectedResponse BL.ByteString+--   | BetterPongTimeoutNoResponse+--   deriving Show+-- instance Exception BetterPongTimeout++-- data PingPongOptions = PingPongOptions {+--   pingInterval :: Int -- ^ Interval in seconds+--   , pongTimeout :: Int -- ^ Timeout in seconds+--   , pingAction :: Int -> IO () -- ^ Action to perform after sending a ping+--   , pingMessage :: Text -> IO () -- ^ Message to log+-- }+-- defaultPingPongOptions :: PingPongOptions+-- defaultPingPongOptions = PingPongOptions {+--   pingInterval = 15+--   , pongTimeout = 30+--   , pingAction = const $ return ()+--   , pingMessage = const $ return ()+-- }++-- withBetterPingPong :: MonadUnliftIO m => PingPongOptions -> WS.Connection -> (WS.Connection -> m ()) -> m ()+-- withBetterPingPong (PingPongOptions {..}) connection app = void $+--   withAsync (app connection) $ \appAsync -> do+--     withAsync (liftIO pingPongThread) $ \pingAsync -> do+--       waitAnyCancel [appAsync, pingAsync]+--     where+--       pingPongThread = do+--         -- Make sure the heartbeat MVar is empty+--         _ <- tryTakeMVar (WS.connectionHeartbeat connection)++--         flip withException reportPingPongException $ flip fix (0 :: Int) $ \loop n -> do+--           let bytes :: BL.ByteString = Builder.toLazyByteString $ Builder.int64BE $ fromIntegral n++--           WS.sendPing connection bytes++--           timeout (pongTimeout * 1000 * 1000) (takeMVar (WS.connectionHeartbeat connection)) >>= \case+--             Just _ -> return ()+--             Nothing -> throwIO $ BetterPongTimeoutNoResponse++--           threadDelay (pongTimeout * 1000 * 1000)+--           loop (n + 1)++--       reportPingPongException :: SomeException -> IO ()+--       reportPingPongException (fromException -> Just (AsyncCancelled {})) = return ()+--       reportPingPongException e = pingMessage [i|Ping pong thread had exception: #{e}|]
src/Test/WebDriver/Commands/Logs/BiDi.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-}  module Test.WebDriver.Commands.Logs.BiDi (@@ -8,162 +7,59 @@   , withRecordLogsViaBiDi'   ) where -import Control.Concurrent.STM (retry)-import Control.Monad (forever)-import Control.Monad.Fix (fix) import Control.Monad.IO.Unlift-import Control.Monad.Logger (MonadLogger, logDebugN, logErrorN, logInfoN, logWarnN)+import Control.Monad.Logger (MonadLogger, logDebugN, logWarnN) import Data.Aeson-import Data.Aeson.TH import Data.Aeson.Types (parseEither)-import qualified Data.List as L import Data.String.Interpolate import Data.Text (Text) import qualified Network.URI as URI-import qualified Network.WebSockets as WS-import Test.WebDriver.Capabilities.Aeson+import Test.WebDriver.Commands.BiDi.Session import Test.WebDriver.Commands.Logs.Common import Test.WebDriver.Types-import Text.Read (readMaybe)-import UnliftIO.Async (withAsync)-import UnliftIO.Exception-import UnliftIO.STM (atomically, newTVarIO, readTVar, writeTVar)-import UnliftIO.Timeout (timeout)  -data BiDiLogEvent = BiDiLogEvent {-  biDiType :: Text-  , biDiMethod :: Text-  , biDiParams :: Value-  } deriving Show-deriveFromJSON toCamel2 ''BiDiLogEvent--data BiDiResponse = BiDiResponse {-  biDiResponseType :: Text-  , biDiResponseId :: Int-  , biDiResponseResult :: Maybe Value-  , biDiResponseError :: Maybe Value-  } deriving Show-deriveFromJSON toCamel3 ''BiDiResponse+logEvents :: [Text]+logEvents = ["log.entryAdded"]  -- | Wrapper around 'withRecordLogsViaBiDi'' which uses the WebSocket URL from -- the current 'Session'. You must make sure to pass '_capabilitiesWebSocketUrl' -- = @Just True@ to enable this. This will not work with Selenium 3.-withRecordLogsViaBiDi :: (WebDriver m, MonadLogger m) => (LogEntry -> m ()) -> m a -> m a-withRecordLogsViaBiDi cb action = do-  Session {..} <- getSession-  webSocketUrl <- case sessionWebSocketUrl of-    Nothing -> throwIO $ userError [i|Session wasn't configured with a BiDi WebSocket URL when trying to record logs. Make sure to enable _capabilitiesWebSocketUrl.|]-    Just x -> pure x--  uri <- case URI.parseURI webSocketUrl of-    Just x -> pure x-    Nothing -> throwIO $ userError [i|Couldn't parse WebSocket URL: #{webSocketUrl}|]--  withRecordLogsViaBiDi' uri cb action+withRecordLogsViaBiDi :: (WebDriver m, MonadLogger m) => BiDiOptions -> (LogEntry -> m ()) -> m a -> m a+withRecordLogsViaBiDi biDiOptions cb action = do+  withBiDiSession biDiOptions logEvents (mkLogCallback cb) action  -- | Connect to WebSocket URL and subscribe to log events using the W3C BiDi protocol; see -- <https://w3c.github.io/webdriver-bidi/>.-withRecordLogsViaBiDi' :: (MonadUnliftIO m, MonadLogger m) => URI.URI -> (LogEntry -> m ()) -> m a -> m a-withRecordLogsViaBiDi' uri@(URI.URI { uriAuthority=(Just (URI.URIAuth {uriPort=(readMaybe . L.drop 1 -> Just (port :: Int)), ..})), .. }) cb action = do-  subscriptionStatus <- newTVarIO Nothing--  withAsync (backgroundAction subscriptionStatus) $ \_ -> do-    -- Wait for subscription to be confirmed or errored before proceeding-    result <- atomically $ do-      status <- readTVar subscriptionStatus-      case status of-        Nothing -> retry-        Just (Left err) -> pure (Left err)-        Just (Right ()) -> pure (Right ())--    case result of-      Left err -> throwIO err-      Right () -> action--  where-    backgroundAction subscriptionStatus = withRunInIO $ \runInIO -> do-      result <- tryAny $ do-        runInIO $ logDebugN [i|BiDi: Connecting to #{uriRegName}:#{port}#{uriPath}|]--        liftIO $ WS.runClient uriRegName port uriPath $ \conn -> do-          runInIO $ logInfoN "BiDi: Connected successfully"--          -- Send subscription request for console logs-          runInIO $ logDebugN "BiDi: Sending subscription request"-          WS.sendTextData conn $ encode $ object [-            "id" .= (1 :: Int)-            , "method" .= ("session.subscribe" :: Text)-            , "params" .= object [-                "events" .= (["log.entryAdded"] :: [Text])-              ]-            ]-          runInIO $ logDebugN "BiDi: Sent subscription request, waiting for response..."--          subscriptionResult <- timeout 15_000_000 $ fix $ \loop -> do-            msg <- WS.receiveData conn-            runInIO $ logDebugN [i|BiDi: Waiting for subscription response: #{msg}|]-            case decode msg of-              Just response@(BiDiResponse responseType responseId _ _)-                | responseType == "success" && responseId == 1 -> do-                    runInIO $ logInfoN "BiDi: Subscription successful!"-                    atomically $ writeTVar subscriptionStatus (Just (Right ()))-                | responseType == "error" && responseId == 1 -> do-                    let errMsg = "BiDi subscription failed: " ++ show response-                    runInIO $ logErrorN [i|BiDi: #{errMsg}|]-                    atomically $ writeTVar subscriptionStatus (Just (Left (toException (userError errMsg))))-                | otherwise -> do-                    runInIO $ logDebugN [i|BiDi: Ignoring response with type #{responseType}, ID #{responseId}|]-                    loop-              Nothing -> do-                runInIO $ logDebugN [i|BiDi: Not a BiDiResponse, continuing to wait for subscription response (#{msg})|]-                loop--          case subscriptionResult of-            Nothing -> do-              runInIO $ logErrorN "BiDi: Subscription response timed out"-              atomically $ writeTVar subscriptionStatus (Just (Left (toException (userError "BiDi subscription response timed out"))))-            Just () -> do-              runInIO $ logDebugN "BiDi: Starting log event listener"-              forever $ do-                msg <- WS.receiveData conn-                runInIO $ logDebugN [i|BiDi: Received log event: #{msg}|]-                case decode msg of-                  Just (BiDiLogEvent "event" "log.entryAdded" params) ->-                    case parseBiDiLogEntry params of-                      Just logEntry -> runInIO (cb logEntry)-                      Nothing -> runInIO $ logWarnN "BiDi: Failed to parse log entry"-                  _ -> runInIO $ logDebugN [i|BiDi: Ignoring non-log event message: #{msg}|]+withRecordLogsViaBiDi' :: forall m a. (MonadUnliftIO m, MonadLogger m) => BiDiOptions -> Int -> URI.URI -> (LogEntry -> m ()) -> m a -> m a+withRecordLogsViaBiDi' biDiOptions bidiSessionId uri cb action =+  withBiDiSession' biDiOptions bidiSessionId uri logEvents (mkLogCallback cb) action -      case result of-        Left ex -> do-          runInIO $ logErrorN [i|BiDi: got exception (URI #{uri}): #{ex}|]-          atomically $ writeTVar subscriptionStatus (Just (Left ex))-        Right () -> pure ()-withRecordLogsViaBiDi' uri _cb _action =-  throwIO $ userError [i|WebSocket URL didn't contain an authority: #{uri}|]+mkLogCallback :: (MonadLogger m) => (LogEntry -> m ()) -> BiDiEvent -> m ()+mkLogCallback cb (BiDiEvent "event" "log.entryAdded" params) = case parseBiDiLogEntry params of+  Just logEntry -> cb logEntry+  Nothing -> logWarnN [i|BiDi: Failed to parse log entry: #{params}|]+mkLogCallback _cb x =+  logDebugN [i|BiDi: Ignoring non-log event message: #{x}|] --- | Convert BiDi log parameters to LogEntry parseBiDiLogEntry :: Value -> Maybe LogEntry-parseBiDiLogEntry = \case-  Object o -> case parseEither parseLogEntry o of-    Right entry -> Just entry-    Left _ -> Nothing-  _ -> Nothing+parseBiDiLogEntry (Object o) = case parseEither parseLogEntry o of+  Right entry -> Just entry+  Left _ -> Nothing   where-    parseLogEntry o = do-      timestamp <- o .: "timestamp"-      levelText <- o .: "level"-      message <- o .: "text"+    parseLogEntry o' = do+      timestamp <- o' .: "timestamp"+      levelText <- o' .: "level"+      message <- o' .: "text"       level <- case parseLogLevel levelText of         Just l -> pure l         Nothing -> fail "Invalid log level"       pure $ LogEntry (round (timestamp :: Double)) level message      parseLogLevel :: Text -> Maybe LogLevel-    parseLogLevel = \case-      "debug" -> Just LogDebug-      "info" -> Just LogInfo-      "warn" -> Just LogWarning-      "error" -> Just LogSevere-      _ -> Nothing+    parseLogLevel "debug" = Just LogDebug+    parseLogLevel "info" = Just LogInfo+    parseLogLevel "warn" = Just LogWarning+    parseLogLevel "error" = Just LogSevere+    parseLogLevel _ = Nothing+parseBiDiLogEntry _ = Nothing
src/Test/WebDriver/LaunchDriver.hs view
@@ -36,6 +36,7 @@ import Test.WebDriver.Util.Sockets import Text.Read (readMaybe) import UnliftIO.Async+import UnliftIO.Environment import UnliftIO.Exception import UnliftIO.Process import UnliftIO.Timeout@@ -48,15 +49,22 @@    port <- findFreePortOrException -  (programName, args) <- getArguments port driverConfig+  (programName, args, maybeEnv) <- getArguments port driverConfig   logDebugN [i|#{programName} #{T.unwords $ fmap T.pack args}|]    (hRead, hWrite) <- createPipe +  envToUse <- case maybeEnv of+    Nothing -> pure Nothing+    Just extraEnv -> do+      env <- getEnvironment+      return $ Just (extraEnv <> env)+   let cp = (proc programName args) {         create_group = True         , std_out = UseHandle hWrite         , std_err = UseHandle hWrite+        , env = envToUse         }    (_, _, _, p) <- createProcess cp@@ -132,7 +140,7 @@        return driver -getArguments :: (MonadIO m, MonadLogger m) => PortNumber -> DriverConfig -> m (FilePath, [String])+getArguments :: (MonadIO m, MonadLogger m) => PortNumber -> DriverConfig -> m (FilePath, [String], Maybe [(String, String)]) getArguments port (DriverConfigSeleniumJar {..}) = do   javaArgs :: [String] <- mconcat <$> mapM getSubDriverArgs driverConfigSubDrivers @@ -148,11 +156,11 @@   let fullArgs = javaArgs                <> ["-jar", driverConfigSeleniumJar]                <> extraArgs-  return (driverConfigJava, fullArgs <> driverConfigJavaFlags)+  return (driverConfigJava, fullArgs <> driverConfigJavaFlags, driverConfigJavaExtraEnv) getArguments port (DriverConfigChromedriver {..}) = do-  return (driverConfigChromedriver, ["--port=" <> show port] <> driverConfigChromedriverFlags)+  return (driverConfigChromedriver, ["--port=" <> show port] <> driverConfigChromedriverFlags, driverConfigChromedriverExtraEnv) getArguments port (DriverConfigGeckodriver {..}) = do-  return (driverConfigGeckodriver, ["--port", show port] <> driverConfigGeckodriverFlags)+  return (driverConfigGeckodriver, ["--port", show port] <> driverConfigGeckodriverFlags, driverConfigGeckodriverExtraEnv)  autodetectSeleniumVersionByFileName :: FilePath -> Maybe SeleniumVersion autodetectSeleniumVersionByFileName (takeFileName -> seleniumJar) = case autodetectSeleniumMajorVersionByFileName of@@ -240,7 +248,10 @@ teardownDriver :: (MonadUnliftIO m, MonadLogger m) => Driver -> m () teardownDriver (Driver {..}) = do   case _driverProcess of-    Just p -> terminateProcess p+    Just p -> do+      terminateProcess p+      -- Reap the child process to avoid leaving zombies.+      void $ liftIO $ waitForProcess p     Nothing -> return ()   case _driverLogAsync of     Just x -> cancel x
src/Test/WebDriver/Types.hs view
@@ -51,6 +51,7 @@ import UnliftIO.Concurrent import UnliftIO.Exception import UnliftIO.Process+import UnliftIO.STM   -- | The 'WebDriverContext' is an opaque type used by this library for@@ -98,6 +99,8 @@     driverConfigJava :: FilePath     -- | Extra flags to pass to @java@.     , driverConfigJavaFlags :: [String]+    -- | Extra flags to pass to @java@.+    , driverConfigJavaExtraEnv :: Maybe [(String, String)]     -- | Path to @selenium.jar@ file.     , driverConfigSeleniumJar :: FilePath     -- | Specify if this is Selenium 3 or 4. If this is not provided, we'll try to autodetect.@@ -112,6 +115,8 @@       driverConfigGeckodriver :: FilePath       -- | Extra flags to pass to @geckodriver@.       , driverConfigGeckodriverFlags :: [String]+      -- | Extra environment variables to pass to @geckodriver@.+      , driverConfigGeckodriverExtraEnv :: Maybe [(String, String)]       -- | Path to @firefox@ binary.       , driverConfigFirefox :: FilePath       -- | Directory in which to place driver logs.@@ -122,6 +127,8 @@       driverConfigChromedriver :: FilePath       -- | Extra flags to pass to @chromedriver@.       , driverConfigChromedriverFlags :: [String]+      -- | Extra environment variables to pass to @chromedriver@.+      , driverConfigChromedriverExtraEnv :: Maybe [(String, String)]       -- | Path to @chrome@ binary.       , driverConfigChrome :: FilePath       -- | Directory in which to place driver logs.@@ -140,6 +147,8 @@   , sessionId :: SessionId   , sessionName :: String   , sessionWebSocketUrl :: Maybe String+  -- | Used to generate IDs for BiDi.+  , sessionIdCounter :: TVar Int   } instance Show Session where   show (Session {sessionDriver=(Driver {..}), ..}) = [i|Session<[#{sessionId}] at #{_driverHostname}:#{_driverPort}#{_driverBasePath}>|]
tests/Main.hs view
@@ -47,6 +47,7 @@               , driverConfigSubDrivers = subDrivers               , driverConfigLogDir = Just dir               , driverConfigJavaFlags = []+              , driverConfigJavaExtraEnv = Nothing               , driverConfigSeleniumVersion = Just Selenium3               } @@ -64,6 +65,7 @@               , driverConfigSubDrivers = subDrivers               , driverConfigLogDir = Just dir               , driverConfigJavaFlags = []+              , driverConfigJavaExtraEnv = Nothing               , driverConfigSeleniumVersion = Just Selenium4               } @@ -79,6 +81,7 @@               , driverConfigChrome = chrome               , driverConfigLogDir = Just dir               , driverConfigChromedriverFlags = []+              , driverConfigChromedriverExtraEnv = Nothing               }    let introduceGeckodriver :: forall ctx. (HasBaseContext ctx, HasNixContext ctx) => SpecFree (LabelValue "driverConfig" DriverConfig :> ctx) IO () -> SpecFree ctx IO ()@@ -93,6 +96,7 @@               , driverConfigFirefox = firefox               , driverConfigLogDir = Just dir               , driverConfigGeckodriverFlags = []+              , driverConfigGeckodriverExtraEnv = Nothing               }    let UserOptions {optBrowserToUse} = optUserOptions clo@@ -112,19 +116,19 @@         describe "geckodriver direct" $ introduceGeckodriver $ introduceWebDriverContext Spec.spec  --- | Nixpkgs release 24.05, accessed 6\/30\/2025.+-- | Nixpkgs nixos-unstable, accessed 6\/2\/2026 (provides google-chrome 148.0.7778.215). -- You can compute updated values for this release (or others) by running--- nix-prefetch-github NixOS nixpkgs --rev release-25.05+-- nix-prefetch-github NixOS nixpkgs --rev nixos-unstable -- We pin this here rather than using 'nixpkgsReleaseDefault' from sandwich-contexts--- so that sandwich updates can't break this (especially on aarch64-darwin, where--- google-chrome isn't available on older versions of release-24.05). Also, firefox--- isn't available for macOS on older Nixpkgs releases.+-- so that sandwich updates can't break this. Note that 'google-chrome' fetches a+-- versioned .deb from Google, which gets removed once a newer Chrome stable ships, so+-- this rev needs bumping periodically to a Nixpkgs whose google-chrome is current. nixpkgsRelease :: NixpkgsDerivation nixpkgsRelease = NixpkgsDerivationFetchFromGitHub {   nixpkgsDerivationOwner = "NixOS"   , nixpkgsDerivationRepo = "nixpkgs"-  , nixpkgsDerivationRev = "32bd9b9bf9dd95eafff1e83da314c96719908657"-  , nixpkgsDerivationSha256 = "sha256-HXDDEjEBMycmwkOiU045bL3yuhOK1+nZZd3zsBh6zsA="+  , nixpkgsDerivationRev = "331800de5053fcebacf6813adb5db9c9dca22a0c"+  , nixpkgsDerivationSha256 = "sha256-x5UQuRsH3MqI0U9afaXSNqzTPSeZlRLvFAav2Ux1pNw="   , nixpkgsDerivationAllowUnfree = True   } @@ -136,6 +140,7 @@         , driverConfigChrome = browserDependenciesChromeChrome         , driverConfigLogDir = Just dir         , driverConfigChromedriverFlags = []+        , driverConfigChromedriverExtraEnv = Nothing         }]   BrowserDependenciesFirefox {..} -> return [     DriverConfigGeckodriver {@@ -143,6 +148,7 @@         , driverConfigFirefox = browserDependenciesFirefoxFirefox         , driverConfigLogDir = Just dir         , driverConfigGeckodriverFlags = []+        , driverConfigGeckodriverExtraEnv = Nothing     }]
tests/Spec/LogsBiDi.hs view
@@ -26,7 +26,7 @@     allLogEntries <- newIORef (mempty :: Seq LogEntry)      let cb logEntry = atomicModifyIORef' allLogEntries (\x -> (x |> logEntry, ()))-    withRecordLogsViaBiDi cb $ do+    withRecordLogsViaBiDi defaultBiDiOptions cb $ do       ignoreReturn $ executeJS [] [i|console.log('log message from haskell-webdriver');|]       ignoreReturn $ executeJS [] [i|console.warn('warn message from haskell-webdriver');|]       ignoreReturn $ executeJS [] [i|console.error('error message from haskell-webdriver');|]
webdriver.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.38.0.+-- This file has been generated from package.yaml by hpack version 0.39.1. -- -- see: https://github.com/sol/hpack  name:           webdriver-version:        0.14.0.0+version:        0.15.0.0 synopsis:       a Haskell client for the Selenium WebDriver protocol description:    A WebDriver client for Haskell.                 You can use it to automate browser sessions for testing, system administration, etc.@@ -60,6 +60,8 @@       Test.WebDriver.Capabilities.Timeouts       Test.WebDriver.Capabilities.UserPromptHandler       Test.WebDriver.Commands.Actions+      Test.WebDriver.Commands.BiDi.NetworkActivity+      Test.WebDriver.Commands.BiDi.Session       Test.WebDriver.Commands.CommandContexts       Test.WebDriver.Commands.Cookies       Test.WebDriver.Commands.DocumentHandling