{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE CPP, QuasiQuotes, ScopedTypeVariables, NamedFieldPuns, Rank2Types #-}

module Test.Sandwich.WebDriver.Internal.Binaries (
  obtainSelenium
  , obtainChromeDriver
  , obtainGeckoDriver
  , downloadSeleniumIfNecessary
  , downloadChromeDriverIfNecessary
  ) where

import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Logger
import Control.Monad.Trans.Control (MonadBaseControl)
import Control.Monad.Trans.Except
import Data.String.Interpolate
import qualified Data.Text as T
import GHC.Stack
import System.Directory
import System.FilePath
import System.Process
import Test.Sandwich.Logging
import Test.Sandwich.WebDriver.Internal.Binaries.Util
import Test.Sandwich.WebDriver.Internal.Types
import Test.Sandwich.WebDriver.Internal.Util

type Constraints m = (HasCallStack, MonadLogger m, MonadIO m, MonadBaseControl IO m)

-- * Obtaining binaries

  -- TODO: remove curl dependencies here

-- | Manually obtain a Selenium server JAR file, according to the 'SeleniumToUse' policy,
-- storing it under the provided 'FilePath' if necessary and returning the exact path.
obtainSelenium :: (MonadIO m, MonadLogger m) => FilePath -> SeleniumToUse -> m (Either T.Text FilePath)
obtainSelenium :: FilePath -> SeleniumToUse -> m (Either Text FilePath)
obtainSelenium FilePath
toolsDir (DownloadSeleniumFrom FilePath
url) = do
  let seleniumPath :: FilePath
seleniumPath = [i|#{toolsDir}/selenium-server-standalone.jar|]
  IO () -> m ()
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 -> FilePath
takeDirectory FilePath
seleniumPath)
  m Bool -> m () -> m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
seleniumPath) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    m FilePath -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m FilePath -> m ()) -> m FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ IO FilePath -> m FilePath
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
$ CreateProcess -> FilePath -> IO FilePath
readCreateProcess (FilePath -> CreateProcess
shell [i|curl #{url} -o #{seleniumPath}|]) FilePath
""
  Either Text FilePath -> m (Either Text FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text FilePath -> m (Either Text FilePath))
-> Either Text FilePath -> m (Either Text FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either Text FilePath
forall a b. b -> Either a b
Right FilePath
seleniumPath
obtainSelenium FilePath
toolsDir SeleniumToUse
DownloadSeleniumDefault = do
  let seleniumPath :: FilePath
seleniumPath = [i|#{toolsDir}/selenium-server-standalone-3.141.59.jar|]
  IO () -> m ()
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 -> FilePath
takeDirectory FilePath
seleniumPath)
  m Bool -> m () -> m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
seleniumPath) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    m FilePath -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m FilePath -> m ()) -> m FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ IO FilePath -> m FilePath
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
$ CreateProcess -> FilePath -> IO FilePath
readCreateProcess (FilePath -> CreateProcess
shell [i|curl https://selenium-release.storage.googleapis.com/3.141/selenium-server-standalone-3.141.59.jar -o #{seleniumPath}|]) FilePath
""
  Either Text FilePath -> m (Either Text FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text FilePath -> m (Either Text FilePath))
-> Either Text FilePath -> m (Either Text FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either Text FilePath
forall a b. b -> Either a b
Right FilePath
seleniumPath
obtainSelenium FilePath
_ (UseSeleniumAt FilePath
path) =
  (IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
path) m Bool
-> (Bool -> m (Either Text FilePath)) -> m (Either Text FilePath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
False -> Either Text FilePath -> m (Either Text FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text FilePath -> m (Either Text FilePath))
-> Either Text FilePath -> m (Either Text FilePath)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text FilePath
forall a b. a -> Either a b
Left [i|Path '#{path}' didn't exist|]
    Bool
True -> Either Text FilePath -> m (Either Text FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text FilePath -> m (Either Text FilePath))
-> Either Text FilePath -> m (Either Text FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either Text FilePath
forall a b. b -> Either a b
Right FilePath
path

-- | Manually obtain a chromedriver binary, according to the 'ChromeDriverToUse' policy,
-- storing it under the provided 'FilePath' if necessary and returning the exact path.
obtainChromeDriver :: (MonadIO m, MonadLogger m, MonadBaseControl IO m) => FilePath -> ChromeDriverToUse -> m (Either T.Text FilePath)
obtainChromeDriver :: FilePath -> ChromeDriverToUse -> m (Either Text FilePath)
obtainChromeDriver FilePath
toolsDir (DownloadChromeDriverFrom FilePath
url) = do
  let path :: FilePath
path = [i|#{toolsDir}/#{chromeDriverExecutable}|]
  IO () -> m ()
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 -> FilePath
takeDirectory FilePath
path)
  m Bool -> m () -> m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
path) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    m FilePath -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m FilePath -> m ()) -> m FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ IO FilePath -> m FilePath
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
$ CreateProcess -> FilePath -> IO FilePath
readCreateProcess (FilePath -> CreateProcess
shell [i|curl #{url} -o #{path}|]) FilePath
""
  Either Text FilePath -> m (Either Text FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text FilePath -> m (Either Text FilePath))
-> Either Text FilePath -> m (Either Text FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either Text FilePath
forall a b. b -> Either a b
Right FilePath
path
obtainChromeDriver FilePath
toolsDir (DownloadChromeDriverVersion ChromeDriverVersion
chromeDriverVersion) = ExceptT Text m FilePath -> m (Either Text FilePath)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Text m FilePath -> m (Either Text FilePath))
-> ExceptT Text m FilePath -> m (Either Text FilePath)
forall a b. (a -> b) -> a -> b
$ do
  let path :: FilePath
path = FilePath -> ChromeDriverVersion -> FilePath
getChromeDriverPath FilePath
toolsDir ChromeDriverVersion
chromeDriverVersion
  (IO Bool -> ExceptT Text m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ExceptT Text m Bool) -> IO Bool -> ExceptT Text m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
path) ExceptT Text m Bool
-> (Bool -> ExceptT Text m FilePath) -> ExceptT Text m FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> FilePath -> ExceptT Text m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path
    Bool
False -> do
      let downloadPath :: Text
downloadPath = ChromeDriverVersion -> Platform -> Text
getChromeDriverDownloadUrl ChromeDriverVersion
chromeDriverVersion Platform
detectPlatform
      m (Either Text ()) -> ExceptT Text m ()
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either Text ()) -> ExceptT Text m ())
-> m (Either Text ()) -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ Text -> FilePath -> m (Either Text ())
forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadLogger m) =>
Text -> FilePath -> m (Either Text ())
downloadAndUnzipToPath Text
downloadPath FilePath
path
      FilePath -> ExceptT Text m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path
obtainChromeDriver FilePath
toolsDir ChromeDriverToUse
DownloadChromeDriverAutodetect = ExceptT Text m FilePath -> m (Either Text FilePath)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Text m FilePath -> m (Either Text FilePath))
-> ExceptT Text m FilePath -> m (Either Text FilePath)
forall a b. (a -> b) -> a -> b
$ do
  ChromeDriverVersion
version <- m (Either Text ChromeDriverVersion)
-> ExceptT Text m ChromeDriverVersion
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either Text ChromeDriverVersion)
 -> ExceptT Text m ChromeDriverVersion)
-> m (Either Text ChromeDriverVersion)
-> ExceptT Text m ChromeDriverVersion
forall a b. (a -> b) -> a -> b
$ IO (Either Text ChromeDriverVersion)
-> m (Either Text ChromeDriverVersion)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Either Text ChromeDriverVersion)
getChromeDriverVersion
  m (Either Text FilePath) -> ExceptT Text m FilePath
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either Text FilePath) -> ExceptT Text m FilePath)
-> m (Either Text FilePath) -> ExceptT Text m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> ChromeDriverToUse -> m (Either Text FilePath)
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadBaseControl IO m) =>
FilePath -> ChromeDriverToUse -> m (Either Text FilePath)
obtainChromeDriver FilePath
toolsDir (ChromeDriverVersion -> ChromeDriverToUse
DownloadChromeDriverVersion ChromeDriverVersion
version)
obtainChromeDriver FilePath
_ (UseChromeDriverAt FilePath
path) =
  (IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
path) m Bool
-> (Bool -> m (Either Text FilePath)) -> m (Either Text FilePath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
False -> Either Text FilePath -> m (Either Text FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text FilePath -> m (Either Text FilePath))
-> Either Text FilePath -> m (Either Text FilePath)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text FilePath
forall a b. a -> Either a b
Left [i|Path '#{path}' didn't exist|]
    Bool
True -> Either Text FilePath -> m (Either Text FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text FilePath -> m (Either Text FilePath))
-> Either Text FilePath -> m (Either Text FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either Text FilePath
forall a b. b -> Either a b
Right FilePath
path

-- | Manually obtain a geckodriver binary, according to the 'GeckoDriverToUse' policy,
-- storing it under the provided 'FilePath' if necessary and returning the exact path.
obtainGeckoDriver :: (MonadIO m, MonadLogger m, MonadBaseControl IO m) => FilePath -> GeckoDriverToUse -> m (Either T.Text FilePath)
obtainGeckoDriver :: FilePath -> GeckoDriverToUse -> m (Either Text FilePath)
obtainGeckoDriver FilePath
toolsDir (DownloadGeckoDriverFrom FilePath
url) = do
  let path :: FilePath
path = [i|#{toolsDir}/#{geckoDriverExecutable}|]
  IO () -> m ()
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 -> FilePath
takeDirectory FilePath
path)
  m Bool -> m () -> m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
path) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    m FilePath -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m FilePath -> m ()) -> m FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ IO FilePath -> m FilePath
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
$ CreateProcess -> FilePath -> IO FilePath
readCreateProcess (FilePath -> CreateProcess
shell [i|curl #{url} -o #{path}|]) FilePath
""
  Either Text FilePath -> m (Either Text FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text FilePath -> m (Either Text FilePath))
-> Either Text FilePath -> m (Either Text FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either Text FilePath
forall a b. b -> Either a b
Right FilePath
path
obtainGeckoDriver FilePath
toolsDir (DownloadGeckoDriverVersion GeckoDriverVersion
geckoDriverVersion) = ExceptT Text m FilePath -> m (Either Text FilePath)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Text m FilePath -> m (Either Text FilePath))
-> ExceptT Text m FilePath -> m (Either Text FilePath)
forall a b. (a -> b) -> a -> b
$ do
  let path :: FilePath
path = FilePath -> GeckoDriverVersion -> FilePath
getGeckoDriverPath FilePath
toolsDir GeckoDriverVersion
geckoDriverVersion
  (IO Bool -> ExceptT Text m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ExceptT Text m Bool) -> IO Bool -> ExceptT Text m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
path) ExceptT Text m Bool
-> (Bool -> ExceptT Text m FilePath) -> ExceptT Text m FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> FilePath -> ExceptT Text m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path
    Bool
False -> do
      let downloadPath :: Text
downloadPath = GeckoDriverVersion -> Platform -> Text
getGeckoDriverDownloadUrl GeckoDriverVersion
geckoDriverVersion Platform
detectPlatform
      m (Either Text ()) -> ExceptT Text m ()
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either Text ()) -> ExceptT Text m ())
-> m (Either Text ()) -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ Text -> FilePath -> m (Either Text ())
forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadLogger m) =>
Text -> FilePath -> m (Either Text ())
downloadAndUntarballToPath Text
downloadPath FilePath
path
      FilePath -> ExceptT Text m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path
obtainGeckoDriver FilePath
toolsDir GeckoDriverToUse
DownloadGeckoDriverAutodetect = ExceptT Text m FilePath -> m (Either Text FilePath)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Text m FilePath -> m (Either Text FilePath))
-> ExceptT Text m FilePath -> m (Either Text FilePath)
forall a b. (a -> b) -> a -> b
$ do
  GeckoDriverVersion
version <- m (Either Text GeckoDriverVersion)
-> ExceptT Text m GeckoDriverVersion
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either Text GeckoDriverVersion)
 -> ExceptT Text m GeckoDriverVersion)
-> m (Either Text GeckoDriverVersion)
-> ExceptT Text m GeckoDriverVersion
forall a b. (a -> b) -> a -> b
$ IO (Either Text GeckoDriverVersion)
-> m (Either Text GeckoDriverVersion)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Either Text GeckoDriverVersion)
getGeckoDriverVersion
  m (Either Text FilePath) -> ExceptT Text m FilePath
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either Text FilePath) -> ExceptT Text m FilePath)
-> m (Either Text FilePath) -> ExceptT Text m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> GeckoDriverToUse -> m (Either Text FilePath)
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadBaseControl IO m) =>
FilePath -> GeckoDriverToUse -> m (Either Text FilePath)
obtainGeckoDriver FilePath
toolsDir (GeckoDriverVersion -> GeckoDriverToUse
DownloadGeckoDriverVersion GeckoDriverVersion
version)
obtainGeckoDriver FilePath
_ (UseGeckoDriverAt FilePath
path) =
  (IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
path) m Bool
-> (Bool -> m (Either Text FilePath)) -> m (Either Text FilePath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
False -> Either Text FilePath -> m (Either Text FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text FilePath -> m (Either Text FilePath))
-> Either Text FilePath -> m (Either Text FilePath)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text FilePath
forall a b. a -> Either a b
Left [i|Path '#{path}' didn't exist|]
    Bool
True -> Either Text FilePath -> m (Either Text FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text FilePath -> m (Either Text FilePath))
-> Either Text FilePath -> m (Either Text FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either Text FilePath
forall a b. b -> Either a b
Right FilePath
path

-- * Lower level helpers


downloadSeleniumIfNecessary :: Constraints m => FilePath -> m (Either T.Text FilePath)
downloadSeleniumIfNecessary :: FilePath -> m (Either Text FilePath)
downloadSeleniumIfNecessary FilePath
toolsDir = m FilePath -> m (Either Text FilePath)
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
m a -> m (Either Text a)
leftOnException' (m FilePath -> m (Either Text FilePath))
-> m FilePath -> m (Either Text FilePath)
forall a b. (a -> b) -> a -> b
$ do
  let seleniumPath :: FilePath
seleniumPath = [i|#{toolsDir}/selenium-server.jar|]
  (IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Bool
doesFileExist FilePath
seleniumPath) m Bool -> (Bool -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> m () -> m ()) -> m () -> Bool -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FilePath -> m ()
forall (m :: * -> *). Constraints m => FilePath -> m ()
downloadSelenium FilePath
seleniumPath))
  FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
seleniumPath

downloadSelenium :: Constraints m => FilePath -> m ()
downloadSelenium :: FilePath -> m ()
downloadSelenium FilePath
seleniumPath = m FilePath -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m FilePath -> m ()) -> m FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ do
  Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
info [i|Downloading selenium-server.jar to #{seleniumPath}|]
  IO () -> m ()
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 -> FilePath
takeDirectory FilePath
seleniumPath)
  IO FilePath -> m FilePath
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
$ CreateProcess -> FilePath -> IO FilePath
readCreateProcess (FilePath -> CreateProcess
shell [i|curl https://selenium-release.storage.googleapis.com/3.141/selenium-server-standalone-3.141.59.jar -o #{seleniumPath}|]) FilePath
""

downloadChromeDriverIfNecessary' :: Constraints m => FilePath -> ChromeDriverVersion -> m (Either T.Text FilePath)
downloadChromeDriverIfNecessary' :: FilePath -> ChromeDriverVersion -> m (Either Text FilePath)
downloadChromeDriverIfNecessary' FilePath
toolsDir ChromeDriverVersion
chromeDriverVersion = ExceptT Text m FilePath -> m (Either Text FilePath)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Text m FilePath -> m (Either Text FilePath))
-> ExceptT Text m FilePath -> m (Either Text FilePath)
forall a b. (a -> b) -> a -> b
$ do
  let chromeDriverPath :: FilePath
chromeDriverPath = FilePath -> ChromeDriverVersion -> FilePath
getChromeDriverPath FilePath
toolsDir ChromeDriverVersion
chromeDriverVersion

  ExceptT Text m Bool -> ExceptT Text m () -> ExceptT Text m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (IO Bool -> ExceptT Text m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ExceptT Text m Bool) -> IO Bool -> ExceptT Text m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
chromeDriverPath) (ExceptT Text m () -> ExceptT Text m ())
-> ExceptT Text m () -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ do
    let downloadPath :: Text
downloadPath = ChromeDriverVersion -> Platform -> Text
getChromeDriverDownloadUrl ChromeDriverVersion
chromeDriverVersion Platform
detectPlatform
    m (Either Text ()) -> ExceptT Text m ()
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either Text ()) -> ExceptT Text m ())
-> m (Either Text ()) -> ExceptT Text m ()
forall a b. (a -> b) -> a -> b
$ Text -> FilePath -> m (Either Text ())
forall (m :: * -> *).
(MonadIO m, MonadBaseControl IO m, MonadLogger m) =>
Text -> FilePath -> m (Either Text ())
downloadAndUnzipToPath Text
downloadPath FilePath
chromeDriverPath

  FilePath -> ExceptT Text m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
chromeDriverPath

downloadChromeDriverIfNecessary :: Constraints m => FilePath -> m (Either T.Text FilePath)
downloadChromeDriverIfNecessary :: FilePath -> m (Either Text FilePath)
downloadChromeDriverIfNecessary FilePath
toolsDir = ExceptT Text m FilePath -> m (Either Text FilePath)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Text m FilePath -> m (Either Text FilePath))
-> ExceptT Text m FilePath -> m (Either Text FilePath)
forall a b. (a -> b) -> a -> b
$ do
  ChromeDriverVersion
chromeDriverVersion <- m (Either Text ChromeDriverVersion)
-> ExceptT Text m ChromeDriverVersion
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either Text ChromeDriverVersion)
 -> ExceptT Text m ChromeDriverVersion)
-> m (Either Text ChromeDriverVersion)
-> ExceptT Text m ChromeDriverVersion
forall a b. (a -> b) -> a -> b
$ IO (Either Text ChromeDriverVersion)
-> m (Either Text ChromeDriverVersion)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Either Text ChromeDriverVersion)
getChromeDriverVersion
  m (Either Text FilePath) -> ExceptT Text m FilePath
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either Text FilePath) -> ExceptT Text m FilePath)
-> m (Either Text FilePath) -> ExceptT Text m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> ChromeDriverVersion -> m (Either Text FilePath)
forall (m :: * -> *).
Constraints m =>
FilePath -> ChromeDriverVersion -> m (Either Text FilePath)
downloadChromeDriverIfNecessary' FilePath
toolsDir ChromeDriverVersion
chromeDriverVersion

getChromeDriverPath :: FilePath -> ChromeDriverVersion -> FilePath
getChromeDriverPath :: FilePath -> ChromeDriverVersion -> FilePath
getChromeDriverPath FilePath
toolsDir (ChromeDriverVersion (Int
w, Int
x, Int
y, Int
z)) = [i|#{toolsDir}/chromedrivers/#{w}.#{x}.#{y}.#{z}/#{chromeDriverExecutable}|]

getGeckoDriverPath :: FilePath -> GeckoDriverVersion -> FilePath
getGeckoDriverPath :: FilePath -> GeckoDriverVersion -> FilePath
getGeckoDriverPath FilePath
toolsDir (GeckoDriverVersion (Int
x, Int
y, Int
z)) = [i|#{toolsDir}/geckodrivers/#{x}.#{y}.#{z}/#{geckoDriverExecutable}|]

chromeDriverExecutable :: T.Text
chromeDriverExecutable :: Text
chromeDriverExecutable = case Platform
detectPlatform of
  Platform
Windows -> Text
"chromedriver.exe"
  Platform
_ -> Text
"chromedriver"

geckoDriverExecutable :: T.Text
geckoDriverExecutable :: Text
geckoDriverExecutable = case Platform
detectPlatform of
  Platform
Windows -> Text
"geckodriver.exe"
  Platform
_ -> Text
"geckodriver"

downloadAndUnzipToPath :: (MonadIO m, MonadBaseControl IO m, MonadLogger m) => T.Text -> FilePath -> m (Either T.Text ())
downloadAndUnzipToPath :: Text -> FilePath -> m (Either Text ())
downloadAndUnzipToPath Text
downloadPath FilePath
localPath = m () -> m (Either Text ())
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
m a -> m (Either Text a)
leftOnException' (m () -> m (Either Text ())) -> m () -> m (Either Text ())
forall a b. (a -> b) -> a -> b
$ do
  Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
info [i|Downloading #{downloadPath} to #{localPath}|]
  IO () -> m ()
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 -> FilePath
takeDirectory FilePath
localPath)
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IO FilePath -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO FilePath -> IO ()) -> IO FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ CreateProcess -> FilePath -> IO FilePath
readCreateProcess (FilePath -> CreateProcess
shell [i|wget -nc -O - #{downloadPath} | gunzip - > #{localPath}|]) FilePath
""
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IO FilePath -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO FilePath -> IO ()) -> IO FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ CreateProcess -> FilePath -> IO FilePath
readCreateProcess (FilePath -> CreateProcess
shell [i|chmod u+x #{localPath}|]) FilePath
""

downloadAndUntarballToPath :: (MonadIO m, MonadBaseControl IO m, MonadLogger m) => T.Text -> FilePath -> m (Either T.Text ())
downloadAndUntarballToPath :: Text -> FilePath -> m (Either Text ())
downloadAndUntarballToPath Text
downloadPath FilePath
localPath = m () -> m (Either Text ())
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
m a -> m (Either Text a)
leftOnException' (m () -> m (Either Text ())) -> m () -> m (Either Text ())
forall a b. (a -> b) -> a -> b
$ do
  Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
info [i|Downloading #{downloadPath} to #{localPath}|]
  IO () -> m ()
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 -> FilePath
takeDirectory FilePath
localPath)
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IO FilePath -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO FilePath -> IO ()) -> IO FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ CreateProcess -> FilePath -> IO FilePath
readCreateProcess (FilePath -> CreateProcess
shell [i|wget -qO- #{downloadPath} | tar xvz  -C #{takeDirectory localPath}|]) FilePath
""
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ IO FilePath -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO FilePath -> IO ()) -> IO FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ CreateProcess -> FilePath -> IO FilePath
readCreateProcess (FilePath -> CreateProcess
shell [i|chmod u+x #{localPath}|]) FilePath
""

unlessM :: Monad m => m Bool -> m () -> m ()
unlessM :: m Bool -> m () -> m ()
unlessM m Bool
b m ()
s = m Bool
b m Bool -> (Bool -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Bool
t -> Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
t m ()
s)