{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Test.Sandwich.WebDriver.Internal.StartWebDriver where

import Control.Monad
import Control.Monad.Catch (MonadMask)
import Control.Monad.IO.Class
import Control.Monad.IO.Unlift
import Control.Monad.Logger
import Control.Monad.Reader
import Control.Retry
import Data.Default
import Data.Function (fix)
import Data.String.Interpolate
import qualified Data.Text as T
import GHC.Stack
import System.Directory
import System.FilePath
import System.IO (hClose, hGetLine)
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.Capabilities.Extra
import Test.Sandwich.WebDriver.Internal.Dependencies
import Test.Sandwich.WebDriver.Internal.Types
import Test.Sandwich.WebDriver.Internal.Util
import qualified Test.WebDriver as W
import UnliftIO.Async
import UnliftIO.Concurrent
import UnliftIO.Exception
import UnliftIO.Process
import UnliftIO.Timeout

#ifndef mingw32_HOST_OS
import Test.Sandwich.WebDriver.Internal.StartWebDriver.Xvfb
#endif


type Constraints m = (
  HasCallStack, MonadLoggerIO m, MonadUnliftIO m, MonadMask m, MonadFail m
  )

-- | Spin up a Selenium WebDriver and create a WebDriver
startWebDriver :: (
  Constraints m, MonadReader context m, HasBaseContext context
  , HasFile context "java", HasFile context "selenium.jar", HasBrowserDependencies context
  ) => WdOptions -> OnDemandOptions -> FilePath -> m WebDriver
startWebDriver :: forall (m :: * -> *) context.
(Constraints m, MonadReader context m, HasBaseContext context,
 HasFile context "java", HasFile context "selenium.jar",
 HasBrowserDependencies context) =>
WdOptions -> OnDemandOptions -> FilePath -> m WebDriver
startWebDriver wdOptions :: WdOptions
wdOptions@(WdOptions {capabilities :: WdOptions -> Capabilities
capabilities=Capabilities
capabilities'', Int
Maybe Manager
RunMode
WhenToSave
saveSeleniumMessageHistory :: WhenToSave
runMode :: RunMode
httpManager :: Maybe Manager
httpRetryCount :: Int
saveSeleniumMessageHistory :: WdOptions -> WhenToSave
runMode :: WdOptions -> RunMode
httpManager :: WdOptions -> Maybe Manager
httpRetryCount :: WdOptions -> Int
..}) (OnDemandOptions {FfmpegToUse
XvfbToUse
ffmpegToUse :: FfmpegToUse
xvfbToUse :: XvfbToUse
ffmpegToUse :: OnDemandOptions -> FfmpegToUse
xvfbToUse :: OnDemandOptions -> XvfbToUse
..}) FilePath
runRoot = do
  -- Create a unique name for this webdriver so the folder for its log output doesn't conflict with any others
  Text
webdriverName <- (Text
"webdriver_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Text
makeUUID

  -- Directory to log everything for this webdriver
  let webdriverRoot :: FilePath
webdriverRoot = FilePath
runRoot FilePath -> FilePath -> FilePath
</> (Text -> FilePath
T.unpack Text
webdriverName)
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
webdriverRoot

  -- Directory to hold any downloads
  let downloadDir :: FilePath
downloadDir = FilePath
webdriverRoot FilePath -> FilePath -> FilePath
</> FilePath
"Downloads"
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
downloadDir

  -- Get selenium, driver args, and capabilities with browser paths applied
  FilePath
java <- forall (a :: Symbol) context (m :: * -> *).
(MonadReader context m, HasFile context a) =>
m FilePath
askFile @"java"
  FilePath
seleniumPath <- forall (a :: Symbol) context (m :: * -> *).
(MonadReader context m, HasFile context a) =>
m FilePath
askFile @"selenium.jar"
  ([FilePath]
driverArgs, Capabilities
capabilities') <- FilePath -> Capabilities -> m ([FilePath], Capabilities)
forall {m :: * -> *} {context} {a}.
(HasLabel context "browserDependencies" BrowserDependencies,
 MonadReader context m,
 Interpolatable (IsCustomSink a) FilePath a) =>
FilePath -> Capabilities -> m ([a], Capabilities)
fillInCapabilitiesAndGetDriverArgs FilePath
webdriverRoot Capabilities
capabilities''

  -- Set up xvfb if configured
  MVar (OnDemand FilePath)
xvfbOnDemand <- OnDemand FilePath -> m (MVar (OnDemand FilePath))
forall (m :: * -> *) a. MonadIO m => a -> m (MVar a)
newMVar OnDemand FilePath
forall a. OnDemand a
OnDemandNotStarted
  (Maybe XvfbSession
maybeXvfbSession, Maybe [(FilePath, FilePath)]
javaEnv) <- case RunMode
runMode of
#ifndef mingw32_HOST_OS
    RunInXvfb (XvfbConfig {Bool
Maybe (Int, Int)
xvfbResolution :: Maybe (Int, Int)
xvfbStartFluxbox :: Bool
xvfbResolution :: XvfbConfig -> Maybe (Int, Int)
xvfbStartFluxbox :: XvfbConfig -> Bool
..}) -> do
      (XvfbSession
s, [(FilePath, FilePath)]
e) <- Maybe (Int, Int)
-> Bool
-> FilePath
-> XvfbToUse
-> MVar (OnDemand FilePath)
-> m (XvfbSession, [(FilePath, FilePath)])
forall (m :: * -> *) context.
Constraints m context =>
Maybe (Int, Int)
-> Bool
-> FilePath
-> XvfbToUse
-> MVar (OnDemand FilePath)
-> m (XvfbSession, [(FilePath, FilePath)])
makeXvfbSession Maybe (Int, Int)
xvfbResolution Bool
xvfbStartFluxbox FilePath
webdriverRoot XvfbToUse
xvfbToUse MVar (OnDemand FilePath)
xvfbOnDemand
      (Maybe XvfbSession, Maybe [(FilePath, FilePath)])
-> m (Maybe XvfbSession, Maybe [(FilePath, FilePath)])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (XvfbSession -> Maybe XvfbSession
forall a. a -> Maybe a
Just XvfbSession
s, [(FilePath, FilePath)] -> Maybe [(FilePath, FilePath)]
forall a. a -> Maybe a
Just [(FilePath, FilePath)]
e)
#endif
    RunMode
_ -> (Maybe XvfbSession, Maybe [(FilePath, FilePath)])
-> m (Maybe XvfbSession, Maybe [(FilePath, FilePath)])
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe XvfbSession
forall a. Maybe a
Nothing, Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing)

  -- Create a distinct process name
  Text
webdriverProcessName <- (Text
"webdriver_process_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Text
makeUUID)
  let webdriverProcessRoot :: FilePath
webdriverProcessRoot = FilePath
webdriverRoot FilePath -> FilePath -> FilePath
</> Text -> FilePath
T.unpack Text
webdriverProcessName
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
webdriverProcessRoot

  -- 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.
  let policy :: RetryPolicyM m
policy = Int -> RetryPolicyM m
forall (m :: * -> *). Monad m => Int -> RetryPolicyM m
constantDelay Int
0 RetryPolicyM m -> RetryPolicyM m -> RetryPolicyM m
forall a. Semigroup a => a -> a -> a
<> Int -> RetryPolicy
limitRetries Int
10
  (PortNumber
port, Handle
hRead, ProcessHandle
p) <- RetryPolicyM m
-> (RetryStatus -> m (PortNumber, Handle, ProcessHandle))
-> m (PortNumber, Handle, ProcessHandle)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
RetryPolicyM m -> (RetryStatus -> m a) -> m a
recoverAll RetryPolicyM m
policy ((RetryStatus -> m (PortNumber, Handle, ProcessHandle))
 -> m (PortNumber, Handle, ProcessHandle))
-> (RetryStatus -> m (PortNumber, Handle, ProcessHandle))
-> m (PortNumber, Handle, ProcessHandle)
forall a b. (a -> b) -> a -> b
$ \RetryStatus
retryStatus -> (m (PortNumber, Handle, ProcessHandle)
 -> (SomeException -> m ())
 -> m (PortNumber, Handle, ProcessHandle))
-> (SomeException -> m ())
-> m (PortNumber, Handle, ProcessHandle)
-> m (PortNumber, Handle, ProcessHandle)
forall a b c. (a -> b -> c) -> b -> a -> c
flip m (PortNumber, Handle, ProcessHandle)
-> (SomeException -> m ()) -> m (PortNumber, Handle, ProcessHandle)
forall (m :: * -> *) e a b.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m b) -> m a
withException (\(SomeException
e :: SomeException) -> Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
warn [i|Exception in startWebDriver retry: #{e}|]) (m (PortNumber, Handle, ProcessHandle)
 -> m (PortNumber, Handle, ProcessHandle))
-> m (PortNumber, Handle, ProcessHandle)
-> m (PortNumber, Handle, ProcessHandle)
forall a b. (a -> b) -> a -> b
$ do
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RetryStatus -> Int
rsIterNumber RetryStatus
retryStatus Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
warn [i|Trying again to start selenium server (attempt #{rsIterNumber retryStatus})|]

    (Handle
hRead, Handle
hWrite) <- m (Handle, Handle)
forall (m :: * -> *). MonadIO m => m (Handle, Handle)
createPipe
    PortNumber
port <- m PortNumber
forall (m :: * -> *). (MonadIO m, MonadCatch m) => m PortNumber
findFreePortOrException

    let allArgs :: [FilePath]
allArgs = [FilePath]
driverArgs [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath
Item [FilePath]
"-jar", FilePath
Item [FilePath]
seleniumPath
                                , FilePath
Item [FilePath]
"-port", PortNumber -> FilePath
forall a. Show a => a -> FilePath
show PortNumber
port]
    let cp :: CreateProcess
cp = (FilePath -> [FilePath] -> CreateProcess
proc FilePath
java [FilePath]
allArgs) {
               env = javaEnv
               , std_in = Inherit
               , std_out = UseHandle hWrite
               , std_err = UseHandle hWrite
               , create_group = True
             }

    -- Start the process and wait for it to be ready
    Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
debug [i|#{java} #{T.unwords $ fmap T.pack allArgs}|]

    (Maybe Handle
_, Maybe Handle
_, Maybe Handle
_, ProcessHandle
p) <- IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
 -> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a b. (a -> b) -> a -> b
$ CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall (m :: * -> *).
MonadIO m =>
CreateProcess
-> m (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess CreateProcess
cp

    let teardown :: m ()
teardown = do
          ProcessHandle -> Int -> m ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m) =>
ProcessHandle -> Int -> m ()
gracefullyStopProcess ProcessHandle
p Int
30_000_000
          IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hClose Handle
hRead

    -- On exception, make sure the process is gone and the pipe handle is closed
    (m (PortNumber, Handle, ProcessHandle)
 -> (SomeException -> m ())
 -> m (PortNumber, Handle, ProcessHandle))
-> (SomeException -> m ())
-> m (PortNumber, Handle, ProcessHandle)
-> m (PortNumber, Handle, ProcessHandle)
forall a b c. (a -> b -> c) -> b -> a -> c
flip m (PortNumber, Handle, ProcessHandle)
-> (SomeException -> m ()) -> m (PortNumber, Handle, ProcessHandle)
forall (m :: * -> *) e a b.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m b) -> m a
withException (\(SomeException
_ :: SomeException) -> m ()
teardown) (m (PortNumber, Handle, ProcessHandle)
 -> m (PortNumber, Handle, ProcessHandle))
-> m (PortNumber, Handle, ProcessHandle)
-> m (PortNumber, Handle, ProcessHandle)
forall a b. (a -> b) -> a -> b
$ do
      -- 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
      Maybe ()
startupResult <- Int -> m () -> m (Maybe ())
forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> m a -> m (Maybe a)
timeout Int
10_000_000 (m () -> m (Maybe ())) -> m () -> m (Maybe ())
forall a b. (a -> b) -> a -> b
$ (m () -> m ()) -> m ()
forall a. (a -> a) -> a
fix ((m () -> m ()) -> m ()) -> (m () -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \m ()
loop -> do
        Text
line <- (FilePath -> Text) -> m FilePath -> m Text
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Text
T.pack (m FilePath -> m Text) -> m FilePath -> m Text
forall a b. (a -> b) -> a -> b
$ IO FilePath -> m FilePath
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ Handle -> IO FilePath
hGetLine Handle
hRead
        Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
debug Text
line

        if | Text
"Selenium Server is up and running" Text -> Text -> Bool
`T.isInfixOf` Text
line -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
           | Bool
otherwise -> m ()
loop

      case Maybe ()
startupResult of
        Maybe ()
Nothing -> do
          let msg :: Text
msg = [i|Didn't see "up and running" line in Selenium output after 10s.|]
          Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
warn Text
msg
          FilePath -> m (PortNumber, Handle, ProcessHandle)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m) =>
FilePath -> m a
expectationFailure (Text -> FilePath
T.unpack Text
msg)
        Just () -> (PortNumber, Handle, ProcessHandle)
-> m (PortNumber, Handle, ProcessHandle)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PortNumber
port, Handle
hRead, ProcessHandle
p)

  -- TODO: save this in the WebDriver to tear it down later?
  Async Any
_logAsync <- m Any -> m (Async Any)
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (m Any -> m (Async Any)) -> m Any -> m (Async Any)
forall a b. (a -> b) -> a -> b
$ m () -> m Any
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO FilePath -> m FilePath
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> IO FilePath
hGetLine Handle
hRead) m FilePath -> (FilePath -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
debug (Text -> m ()) -> (FilePath -> Text) -> FilePath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack))

  -- Final extra capabilities configuration
  Capabilities
capabilities <-
    WdOptions -> RunMode -> Capabilities -> m Capabilities
forall (m :: * -> *).
Constraints m =>
WdOptions -> RunMode -> Capabilities -> m Capabilities
configureHeadlessCapabilities WdOptions
wdOptions RunMode
runMode Capabilities
capabilities'
    m Capabilities
-> (Capabilities -> m Capabilities) -> m Capabilities
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> Capabilities -> m Capabilities
forall (m :: * -> *).
MonadIO m =>
FilePath -> Capabilities -> m Capabilities
configureDownloadCapabilities FilePath
downloadDir

  -- Make the WebDriver
  FilePath
-> (ProcessHandle, Maybe XvfbSession)
-> WdOptions
-> MVar (Map FilePath WDSession)
-> WDConfig
-> FilePath
-> FfmpegToUse
-> MVar (OnDemand FilePath)
-> XvfbToUse
-> MVar (OnDemand FilePath)
-> WebDriver
WebDriver (FilePath
 -> (ProcessHandle, Maybe XvfbSession)
 -> WdOptions
 -> MVar (Map FilePath WDSession)
 -> WDConfig
 -> FilePath
 -> FfmpegToUse
 -> MVar (OnDemand FilePath)
 -> XvfbToUse
 -> MVar (OnDemand FilePath)
 -> WebDriver)
-> m FilePath
-> m ((ProcessHandle, Maybe XvfbSession)
      -> WdOptions
      -> MVar (Map FilePath WDSession)
      -> WDConfig
      -> FilePath
      -> FfmpegToUse
      -> MVar (OnDemand FilePath)
      -> XvfbToUse
      -> MVar (OnDemand FilePath)
      -> WebDriver)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> m FilePath
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> FilePath
T.unpack Text
webdriverName)
            m ((ProcessHandle, Maybe XvfbSession)
   -> WdOptions
   -> MVar (Map FilePath WDSession)
   -> WDConfig
   -> FilePath
   -> FfmpegToUse
   -> MVar (OnDemand FilePath)
   -> XvfbToUse
   -> MVar (OnDemand FilePath)
   -> WebDriver)
-> m (ProcessHandle, Maybe XvfbSession)
-> m (WdOptions
      -> MVar (Map FilePath WDSession)
      -> WDConfig
      -> FilePath
      -> FfmpegToUse
      -> MVar (OnDemand FilePath)
      -> XvfbToUse
      -> MVar (OnDemand FilePath)
      -> WebDriver)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ProcessHandle, Maybe XvfbSession)
-> m (ProcessHandle, Maybe XvfbSession)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProcessHandle
p, Maybe XvfbSession
maybeXvfbSession)
            m (WdOptions
   -> MVar (Map FilePath WDSession)
   -> WDConfig
   -> FilePath
   -> FfmpegToUse
   -> MVar (OnDemand FilePath)
   -> XvfbToUse
   -> MVar (OnDemand FilePath)
   -> WebDriver)
-> m WdOptions
-> m (MVar (Map FilePath WDSession)
      -> WDConfig
      -> FilePath
      -> FfmpegToUse
      -> MVar (OnDemand FilePath)
      -> XvfbToUse
      -> MVar (OnDemand FilePath)
      -> WebDriver)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> WdOptions -> m WdOptions
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WdOptions
wdOptions {
                       capabilities = capabilities
                     })
            m (MVar (Map FilePath WDSession)
   -> WDConfig
   -> FilePath
   -> FfmpegToUse
   -> MVar (OnDemand FilePath)
   -> XvfbToUse
   -> MVar (OnDemand FilePath)
   -> WebDriver)
-> m (MVar (Map FilePath WDSession))
-> m (WDConfig
      -> FilePath
      -> FfmpegToUse
      -> MVar (OnDemand FilePath)
      -> XvfbToUse
      -> MVar (OnDemand FilePath)
      -> WebDriver)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (MVar (Map FilePath WDSession))
-> m (MVar (Map FilePath WDSession))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Map FilePath WDSession -> IO (MVar (Map FilePath WDSession))
forall (m :: * -> *) a. MonadIO m => a -> m (MVar a)
newMVar Map FilePath WDSession
forall a. Monoid a => a
mempty)
            m (WDConfig
   -> FilePath
   -> FfmpegToUse
   -> MVar (OnDemand FilePath)
   -> XvfbToUse
   -> MVar (OnDemand FilePath)
   -> WebDriver)
-> m WDConfig
-> m (FilePath
      -> FfmpegToUse
      -> MVar (OnDemand FilePath)
      -> XvfbToUse
      -> MVar (OnDemand FilePath)
      -> WebDriver)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> WDConfig -> m WDConfig
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WDConfig
forall a. Default a => a
def { W.wdPort = fromIntegral port
                          , W.wdCapabilities = capabilities
                          , W.wdHTTPManager = httpManager
                          , W.wdHTTPRetryCount = httpRetryCount
                          })
            m (FilePath
   -> FfmpegToUse
   -> MVar (OnDemand FilePath)
   -> XvfbToUse
   -> MVar (OnDemand FilePath)
   -> WebDriver)
-> m FilePath
-> m (FfmpegToUse
      -> MVar (OnDemand FilePath)
      -> XvfbToUse
      -> MVar (OnDemand FilePath)
      -> WebDriver)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> m FilePath
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
downloadDir

            m (FfmpegToUse
   -> MVar (OnDemand FilePath)
   -> XvfbToUse
   -> MVar (OnDemand FilePath)
   -> WebDriver)
-> m FfmpegToUse
-> m (MVar (OnDemand FilePath)
      -> XvfbToUse -> MVar (OnDemand FilePath) -> WebDriver)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FfmpegToUse -> m FfmpegToUse
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FfmpegToUse
ffmpegToUse
            m (MVar (OnDemand FilePath)
   -> XvfbToUse -> MVar (OnDemand FilePath) -> WebDriver)
-> m (MVar (OnDemand FilePath))
-> m (XvfbToUse -> MVar (OnDemand FilePath) -> WebDriver)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> OnDemand FilePath -> m (MVar (OnDemand FilePath))
forall (m :: * -> *) a. MonadIO m => a -> m (MVar a)
newMVar OnDemand FilePath
forall a. OnDemand a
OnDemandNotStarted

            m (XvfbToUse -> MVar (OnDemand FilePath) -> WebDriver)
-> m XvfbToUse -> m (MVar (OnDemand FilePath) -> WebDriver)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> XvfbToUse -> m XvfbToUse
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure XvfbToUse
xvfbToUse
            m (MVar (OnDemand FilePath) -> WebDriver)
-> m (MVar (OnDemand FilePath)) -> m WebDriver
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MVar (OnDemand FilePath) -> m (MVar (OnDemand FilePath))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MVar (OnDemand FilePath)
xvfbOnDemand


stopWebDriver :: Constraints m => WebDriver -> m ()
stopWebDriver :: forall (m :: * -> *). Constraints m => WebDriver -> m ()
stopWebDriver (WebDriver {wdWebDriver :: WebDriver -> (ProcessHandle, Maybe XvfbSession)
wdWebDriver=(ProcessHandle
h, Maybe XvfbSession
maybeXvfbSession)}) = do
  -- | TODO: expose this as an option
  let gracePeriod :: Int
      gracePeriod :: Int
gracePeriod = Int
30000000

  ProcessHandle -> Int -> m ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m) =>
ProcessHandle -> Int -> m ()
gracefullyStopProcess ProcessHandle
h Int
gracePeriod

  Maybe XvfbSession -> (XvfbSession -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust Maybe XvfbSession
maybeXvfbSession ((XvfbSession -> m ()) -> m ()) -> (XvfbSession -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(XvfbSession {Int
FilePath
Maybe ProcessHandle
(Int, Int)
ProcessHandle
xvfbDisplayNum :: Int
xvfbXauthority :: FilePath
xvfbDimensions :: (Int, Int)
xvfbProcess :: ProcessHandle
xvfbFluxboxProcess :: Maybe ProcessHandle
xvfbDisplayNum :: XvfbSession -> Int
xvfbXauthority :: XvfbSession -> FilePath
xvfbDimensions :: XvfbSession -> (Int, Int)
xvfbProcess :: XvfbSession -> ProcessHandle
xvfbFluxboxProcess :: XvfbSession -> Maybe ProcessHandle
..}) -> do
    Maybe ProcessHandle -> (ProcessHandle -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust Maybe ProcessHandle
xvfbFluxboxProcess ((ProcessHandle -> m ()) -> m ())
-> (ProcessHandle -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \ProcessHandle
p -> do
      ProcessHandle -> Int -> m ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m) =>
ProcessHandle -> Int -> m ()
gracefullyStopProcess ProcessHandle
p Int
gracePeriod

    ProcessHandle -> Int -> m ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m) =>
ProcessHandle -> Int -> m ()
gracefullyStopProcess ProcessHandle
xvfbProcess Int
gracePeriod