{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
module Test.WebDriverWrapper.Selenium (startSelenium, getSeleniumIfNeeded) where
import Test.WebDriverWrapper.Constants (defaultSeleniumJarUrl, seleniumPath, downloadPath, geckoDriverPath, seleniumLogPath)
import Test.WebDriverWrapper.Helpers (download)
import System.Directory (createDirectoryIfMissing, doesFileExist)
import Control.Monad (unless)
import GHC.IO.Handle ( Handle, hGetLine, hClose )
import System.Process (ProcessHandle, createProcess)
import Data.String.Interpolate (i)
import System.IO (openFile)
import GHC.IO.IOMode (IOMode(..))
import Control.Retry (retryOnError, RetryStatus (..))
import System.IO.Error (isEOFError)
import UnliftIO.Retry ( constantDelay, limitRetries )
import Data.Foldable.Extra (orM)
import Data.List (isInfixOf)
import System.Process.Run (proc)
startSelenium :: IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
startSelenium :: IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
startSelenium = do
[Char]
geckoPath <- IO [Char]
geckoDriverPath
[Char]
selPath <- IO [Char]
seleniumPath
[Char]
logFile <- IO [Char]
seleniumLogPath
[Char] -> [Char] -> IO ()
writeFile [Char]
logFile [Char]
""
let
selArgs :: [[Char]]
selArgs = [[i|-Dwebdriver.gecko.driver=#{geckoPath}|], [Char]
"-jar", [Char]
selPath ,[Char]
"-log", [Char]
logFile]
processParams :: CreateProcess
processParams = [Char] -> [[Char]] -> CreateProcess
proc [Char]
"java" [[Char]]
selArgs
(Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
processHandles <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess CreateProcess
processParams
IO ()
waitForSeleniumStart
(Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
processHandles
waitForSeleniumStart :: IO()
waitForSeleniumStart :: IO ()
waitForSeleniumStart = do
[Char]
logFile <- IO [Char]
seleniumLogPath
Handle
fileHandle <- [Char] -> IOMode -> IO Handle
openFile [Char]
logFile IOMode
ReadMode
Bool
succeeded <- RetryPolicyM IO
-> (RetryStatus -> IOError -> IO Bool)
-> (RetryStatus -> IO Bool)
-> IO Bool
forall (m :: * -> *) e a.
(Functor m, MonadIO m, MonadError e m) =>
RetryPolicyM m
-> (RetryStatus -> e -> m Bool) -> (RetryStatus -> m a) -> m a
retryOnError RetryPolicyM IO
retryPolicy'
(\RetryStatus
_ IOError
e -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ IOError -> Bool
isEOFError IOError
e)
(\RetryStatus
retryStatus -> if RetryStatus -> Int
rsIterNumber RetryStatus
retryStatus Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
599 then Handle -> IO Bool
logFileHasReadyMessage Handle
fileHandle else Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
Handle -> IO ()
hClose Handle
fileHandle
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
succeeded (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Couldn't start Selenium successfully. Check " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
logFile [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" for more information."
where
retryPolicy' :: RetryPolicyM IO
retryPolicy' = Int -> RetryPolicyM IO
forall (m :: * -> *). Monad m => Int -> RetryPolicyM m
constantDelay Int
100000 RetryPolicyM IO -> RetryPolicyM IO -> RetryPolicyM IO
forall a. Semigroup a => a -> a -> a
<> Int -> RetryPolicy
limitRetries Int
600
logFileHasReadyMessage :: Handle -> IO Bool
logFileHasReadyMessage :: Handle -> IO Bool
logFileHasReadyMessage Handle
fileHandle = [IO Bool] -> IO Bool
forall (f :: * -> *) (m :: * -> *).
(Foldable f, Monad m) =>
f (m Bool) -> m Bool
orM [IO Bool]
remainingLines
where
remainingLines :: [IO Bool]
remainingLines = IO Bool -> [IO Bool]
forall a. a -> [a]
repeat IO Bool
hasReadyMessage
hasReadyMessage :: IO Bool
hasReadyMessage = ([Char]
readyMessage [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`) ([Char] -> Bool) -> IO [Char] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO [Char]
hGetLine Handle
fileHandle
readyMessage :: [Char]
readyMessage = [Char]
"Selenium Server is up and running"
getSeleniumIfNeeded :: IO ()
getSeleniumIfNeeded :: IO ()
getSeleniumIfNeeded = do
[Char]
selPath <- IO [Char]
seleniumPath
Bool
hasSelenium <- [Char] -> IO Bool
doesFileExist [Char]
selPath
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hasSelenium IO ()
getSelenium
getSelenium :: IO ()
getSelenium :: IO ()
getSelenium = do
[Char]
downloadPath' <- IO [Char]
downloadPath
[Char]
selPath <- IO [Char]
seleniumPath
Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True [Char]
downloadPath'
[Char] -> [Char] -> IO ()
download [Char]
defaultSeleniumJarUrl [Char]
selPath