{-# LANGUAGE CPP #-}
module Test.Sandwich.WebDriver.Internal.Binaries.Util (
detectPlatform
, detectChromeVersion
, getChromeDriverVersion
, getChromeDriverDownloadUrl
, Platform(..)
, detectFirefoxVersion
, getGeckoDriverVersion
, getGeckoDriverDownloadUrl
) where
import Control.Exception
import Control.Monad.IO.Class
import Control.Monad.Trans.Except
import qualified Data.Aeson as A
import Data.Maybe
import Data.String.Interpolate
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import Network.HTTP.Client
import Network.HTTP.Client.TLS
import Network.HTTP.Conduit (simpleHttp)
import Safe
import System.Exit
import qualified System.Info as SI
import System.Process
import Test.Sandwich.WebDriver.Internal.Types
import Test.Sandwich.WebDriver.Internal.Util
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.KeyMap as HM
#else
import qualified Data.HashMap.Strict as HM
#endif
data Platform = Linux | OSX | Windows deriving (Int -> Platform -> ShowS
[Platform] -> ShowS
Platform -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Platform] -> ShowS
$cshowList :: [Platform] -> ShowS
show :: Platform -> String
$cshow :: Platform -> String
showsPrec :: Int -> Platform -> ShowS
$cshowsPrec :: Int -> Platform -> ShowS
Show, Platform -> Platform -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Platform -> Platform -> Bool
$c/= :: Platform -> Platform -> Bool
== :: Platform -> Platform -> Bool
$c== :: Platform -> Platform -> Bool
Eq)
detectPlatform :: Platform
detectPlatform :: Platform
detectPlatform = case String
SI.os of
String
"windows" -> Platform
Windows
String
"linux" -> Platform
Linux
String
"darwin" -> Platform
OSX
String
_ -> forall a. HasCallStack => String -> a
error [i|Couldn't determine host platform from string: '#{SI.os}'|]
detectChromeVersion :: Maybe FilePath -> IO (Either T.Text ChromeVersion)
detectChromeVersion :: Maybe String -> IO (Either Text ChromeVersion)
detectChromeVersion Maybe String
maybeChromePath = forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
m (Either Text a) -> m (Either Text a)
leftOnException forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
let chromeToUse :: String
chromeToUse = forall a. a -> Maybe a -> a
fromMaybe String
"google-chrome" Maybe String
maybeChromePath
(ExitCode
exitCode, String
stdout, String
stderr) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ CreateProcess -> String -> IO (ExitCode, String, String)
readCreateProcessWithExitCode (String -> CreateProcess
shell (String
chromeToUse forall a. Semigroup a => a -> a -> a
<> String
" --version | grep -Eo \"[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\"")) String
""
Text
rawString <- case ExitCode
exitCode of
ExitFailure Int
_ -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE [i|Couldn't parse google-chrome version. Stdout: '#{stdout}'. Stderr: '#{stderr}'|]
ExitCode
ExitSuccess -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
stdout
case Text -> Text -> [Text]
T.splitOn Text
"." Text
rawString of
[Text -> Maybe Int
tReadMay -> Just Int
w, Text -> Maybe Int
tReadMay -> Just Int
x, Text -> Maybe Int
tReadMay -> Just Int
y, Text -> Maybe Int
tReadMay -> Just Int
z] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Int, Int, Int, Int) -> ChromeVersion
ChromeVersion (Int
w, Int
x, Int
y, Int
z)
[Text]
_ -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE [i|Failed to parse google-chrome version from string: '#{rawString}'|]
getChromeDriverVersion :: Maybe FilePath -> IO (Either T.Text ChromeDriverVersion)
getChromeDriverVersion :: Maybe String -> IO (Either Text ChromeDriverVersion)
getChromeDriverVersion Maybe String
maybeChromePath = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
ChromeVersion
chromeVersion <- forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Maybe String -> IO (Either Text ChromeVersion)
detectChromeVersion Maybe String
maybeChromePath
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ ChromeVersion -> IO (Either Text ChromeDriverVersion)
getChromeDriverVersion' ChromeVersion
chromeVersion
getChromeDriverVersion' :: ChromeVersion -> IO (Either T.Text ChromeDriverVersion)
getChromeDriverVersion' :: ChromeVersion -> IO (Either Text ChromeDriverVersion)
getChromeDriverVersion' (ChromeVersion (Int
w, Int
x, Int
y, Int
_)) = do
let url :: String
url = [i|https://chromedriver.storage.googleapis.com/LATEST_RELEASE_#{w}.#{x}.#{y}|]
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(HttpException
e :: HttpException) -> do
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left [i|Error when requesting '#{url}': '#{e}'|]
)
(do
Text
result :: T.Text <- (Text -> Text
TL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TL.decodeUtf8) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadIO m => String -> m ByteString
simpleHttp String
url
case Text -> Text -> [Text]
T.splitOn Text
"." Text
result of
[Text -> Maybe Int
tReadMay -> Just Int
w, Text -> Maybe Int
tReadMay -> Just Int
x, Text -> Maybe Int
tReadMay -> Just Int
y, Text -> Maybe Int
tReadMay -> Just Int
z] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ (Int, Int, Int, Int) -> ChromeDriverVersion
ChromeDriverVersion (Int
w, Int
x, Int
y, Int
z)
[Text]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left [i|Failed to parse chromedriver version from string: '#{result}'|]
)
getChromeDriverDownloadUrl :: ChromeDriverVersion -> Platform -> T.Text
getChromeDriverDownloadUrl :: ChromeDriverVersion -> Platform -> Text
getChromeDriverDownloadUrl (ChromeDriverVersion (Int
w, Int
x, Int
y, Int
z)) Platform
Linux = [i|https://chromedriver.storage.googleapis.com/#{w}.#{x}.#{y}.#{z}/chromedriver_linux64.zip|]
getChromeDriverDownloadUrl (ChromeDriverVersion (Int
w, Int
x, Int
y, Int
z)) Platform
OSX = [i|https://chromedriver.storage.googleapis.com/#{w}.#{x}.#{y}.#{z}/chromedriver_mac64.zip|]
getChromeDriverDownloadUrl (ChromeDriverVersion (Int
w, Int
x, Int
y, Int
z)) Platform
Windows = [i|https://chromedriver.storage.googleapis.com/#{w}.#{x}.#{y}.#{z}/chromedriver_win32.zip|]
detectFirefoxVersion :: Maybe FilePath -> IO (Either T.Text FirefoxVersion)
detectFirefoxVersion :: Maybe String -> IO (Either Text FirefoxVersion)
detectFirefoxVersion Maybe String
maybeFirefoxPath = forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
m (Either Text a) -> m (Either Text a)
leftOnException forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
let firefoxToUse :: String
firefoxToUse = forall a. a -> Maybe a -> a
fromMaybe String
"firefox" Maybe String
maybeFirefoxPath
(ExitCode
exitCode, String
stdout, String
stderr) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ CreateProcess -> String -> IO (ExitCode, String, String)
readCreateProcessWithExitCode (String -> CreateProcess
shell (String
firefoxToUse forall a. Semigroup a => a -> a -> a
<> String
" --version | grep -Eo \"[0-9]+\\.[0-9]+(\\.[0-9]+)?\"")) String
""
Text
rawString <- case ExitCode
exitCode of
ExitFailure Int
_ -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE [i|Couldn't parse firefox version. Stdout: '#{stdout}'. Stderr: '#{stderr}'|]
ExitCode
ExitSuccess -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
stdout
case Text -> Text -> [Text]
T.splitOn Text
"." Text
rawString of
[Text -> Maybe Int
tReadMay -> Just Int
x, Text -> Maybe Int
tReadMay -> Just Int
y] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Int, Int, Int) -> FirefoxVersion
FirefoxVersion (Int
x, Int
y, Int
0)
[Text -> Maybe Int
tReadMay -> Just Int
x, Text -> Maybe Int
tReadMay -> Just Int
y, Text -> Maybe Int
tReadMay -> Just Int
z] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Int, Int, Int) -> FirefoxVersion
FirefoxVersion (Int
x, Int
y, Int
z)
[Text]
_ -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE [i|Failed to parse firefox version from string: '#{rawString}'|]
getGeckoDriverVersion :: Maybe FilePath -> IO (Either T.Text GeckoDriverVersion)
getGeckoDriverVersion :: Maybe String -> IO (Either Text GeckoDriverVersion)
getGeckoDriverVersion Maybe String
_maybeFirefoxPath = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
let url :: String
url = [i|https://api.github.com/repos/mozilla/geckodriver/releases/latest|]
Request
req <- forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest String
url
Manager
manager <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall (m :: * -> *). MonadIO m => m Manager
newTlsManager
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(HttpException
e :: HttpException) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left [i|Error when requesting '#{url}': '#{e}'|])
(do
Response ByteString
result <- Request -> Manager -> IO (Response ByteString)
httpLbs (Request
req { requestHeaders :: RequestHeaders
requestHeaders = (HeaderName
"User-Agent", ByteString
"foo") forall a. a -> [a] -> [a]
: (Request -> RequestHeaders
requestHeaders Request
req) }) Manager
manager
case forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode forall a b. (a -> b) -> a -> b
$ forall body. Response body -> body
responseBody Response ByteString
result of
Right (A.Object (forall v. Key -> KeyMap v -> Maybe v
HM.lookup Key
"tag_name" -> Just (A.String Text
tag))) -> do
let parts :: [Text]
parts = Text -> Text -> [Text]
T.splitOn Text
"." forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
1 Text
tag
case [Text]
parts of
[Text -> Maybe Int
tReadMay -> Just Int
x, Text -> Maybe Int
tReadMay -> Just Int
y] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ (Int, Int, Int) -> GeckoDriverVersion
GeckoDriverVersion (Int
x, Int
y, Int
0)
[Text -> Maybe Int
tReadMay -> Just Int
x, Text -> Maybe Int
tReadMay -> Just Int
y, Text -> Maybe Int
tReadMay -> Just Int
z] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ (Int, Int, Int) -> GeckoDriverVersion
GeckoDriverVersion (Int
x, Int
y, Int
z)
[Text]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left [i|Unexpected geckodriver release tag: '#{tag}'|]
Either String Value
val -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left [i|Failed to decode GitHub releases: '#{val}'|]
)
getGeckoDriverDownloadUrl :: GeckoDriverVersion -> Platform -> T.Text
getGeckoDriverDownloadUrl :: GeckoDriverVersion -> Platform -> Text
getGeckoDriverDownloadUrl (GeckoDriverVersion (Int
x, Int
y, Int
z)) Platform
Linux = [i|https://github.com/mozilla/geckodriver/releases/download/v#{x}.#{y}.#{z}/geckodriver-v#{x}.#{y}.#{z}-linux64.tar.gz|]
getGeckoDriverDownloadUrl (GeckoDriverVersion (Int
x, Int
y, Int
z)) Platform
OSX = [i|https://github.com/mozilla/geckodriver/releases/download/v#{x}.#{y}.#{z}/geckodriver-v#{x}.#{y}.#{z}-macos.tar.gz|]
getGeckoDriverDownloadUrl (GeckoDriverVersion (Int
x, Int
y, Int
z)) Platform
Windows = [i|https://github.com/mozilla/geckodriver/releases/download/v#{x}.#{y}.#{z}/geckodriver-v#{x}.#{y}.#{z}-win32.tar.gz|]
tReadMay :: Text -> Maybe Int
tReadMay = forall a. Read a => String -> Maybe a
readMay forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack