{-# LANGUAGE CPP, QuasiQuotes, ScopedTypeVariables, NamedFieldPuns, OverloadedStrings, ViewPatterns #-} 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.Convertible import qualified Data.HashMap.Strict as HM import Data.String.Interpolate import qualified Data.Text as T 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 data Platform = Linux | OSX | Windows deriving (Show, Eq) detectPlatform :: Platform detectPlatform = case SI.os of "windows" -> Windows "linux" -> Linux "darwin" -> OSX _ -> error [i|Couldn't determine host platform from string: '#{SI.os}'|] -- * Chrome detectChromeVersion :: IO (Either T.Text ChromeVersion) detectChromeVersion = leftOnException $ runExceptT $ do (exitCode, stdout, stderr) <- liftIO $ readCreateProcessWithExitCode (shell "google-chrome --version | grep -Eo \"[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\"") "" rawString <- case exitCode of ExitFailure _ -> throwE [i|Couldn't parse google-chrome version. Stdout: '#{stdout}'. Stderr: '#{stderr}'|] ExitSuccess -> return $ T.strip $ convert stdout case T.splitOn "." rawString of [tReadMay -> Just w, tReadMay -> Just x, tReadMay -> Just y, tReadMay -> Just z] -> return $ ChromeVersion (w, x, y, z) _ -> throwE [i|Failed to parse google-chrome version from string: '#{rawString}'|] getChromeDriverVersion :: IO (Either T.Text ChromeDriverVersion) getChromeDriverVersion = runExceptT $ do chromeVersion <- ExceptT $ liftIO detectChromeVersion ExceptT $ getChromeDriverVersion' chromeVersion getChromeDriverVersion' :: ChromeVersion -> IO (Either T.Text ChromeDriverVersion) getChromeDriverVersion' (ChromeVersion (w, x, y, _)) = do let url = [i|https://chromedriver.storage.googleapis.com/LATEST_RELEASE_#{w}.#{x}.#{y}|] handle (\(e :: HttpException) -> do return $ Left [i|Error when requesting '#{url}': '#{e}'|] ) (do result :: T.Text <- convert <$> simpleHttp url case T.splitOn "." result of [tReadMay -> Just w, tReadMay -> Just x, tReadMay -> Just y, tReadMay -> Just z] -> return $ Right $ ChromeDriverVersion (w, x, y, z) _ -> return $ Left [i|Failed to parse chromedriver version from string: '#{result}'|] ) getChromeDriverDownloadUrl :: ChromeDriverVersion -> Platform -> T.Text getChromeDriverDownloadUrl (ChromeDriverVersion (w, x, y, z)) Linux = [i|https://chromedriver.storage.googleapis.com/#{w}.#{x}.#{y}.#{z}/chromedriver_linux64.zip|] getChromeDriverDownloadUrl (ChromeDriverVersion (w, x, y, z)) OSX = [i|https://chromedriver.storage.googleapis.com/#{w}.#{x}.#{y}.#{z}/chromedriver_mac64.zip|] getChromeDriverDownloadUrl (ChromeDriverVersion (w, x, y, z)) Windows = [i|https://chromedriver.storage.googleapis.com/#{w}.#{x}.#{y}.#{z}/chromedriver_win32.zip|] -- * Firefox detectFirefoxVersion :: IO (Either T.Text FirefoxVersion) detectFirefoxVersion = leftOnException $ runExceptT $ do (exitCode, stdout, stderr) <- liftIO $ readCreateProcessWithExitCode (shell "firefox --version | grep -Eo \"[0-9]+\\.[0-9]+(\\.[0-9]+)?\"") "" rawString <- case exitCode of ExitFailure _ -> throwE [i|Couldn't parse firefox version. Stdout: '#{stdout}'. Stderr: '#{stderr}'|] ExitSuccess -> return $ T.strip $ convert stdout case T.splitOn "." rawString of [tReadMay -> Just x, tReadMay -> Just y] -> return $ FirefoxVersion (x, y, 0) [tReadMay -> Just x, tReadMay -> Just y, tReadMay -> Just z] -> return $ FirefoxVersion (x, y, z) _ -> throwE [i|Failed to parse firefox version from string: '#{rawString}'|] getGeckoDriverVersion :: IO (Either T.Text GeckoDriverVersion) getGeckoDriverVersion = runExceptT $ do -- firefoxVersion <- ExceptT $ liftIO detectFirefoxVersion -- Just get the latest release on GitHub let url = [i|https://api.github.com/repos/mozilla/geckodriver/releases/latest|] req <- parseRequest url manager <- liftIO newTlsManager ExceptT $ handle (\(e :: HttpException) -> return $ Left [i|Error when requesting '#{url}': '#{e}'|]) (do result <- httpLbs (req { requestHeaders = ("User-Agent", "foo") : (requestHeaders req) }) manager case A.eitherDecode $ responseBody result of Right (A.Object (HM.lookup "tag_name" -> Just (A.String tag))) -> do let parts = T.splitOn "." $ T.drop 1 tag case parts of [tReadMay -> Just x, tReadMay -> Just y] -> return $ Right $ GeckoDriverVersion (x, y, 0) [tReadMay -> Just x, tReadMay -> Just y, tReadMay -> Just z] -> return $ Right $ GeckoDriverVersion (x, y, z) _ -> return $ Left [i|Unexpected geckodriver release tag: '#{tag}'|] val -> return $ Left [i|Failed to decode GitHub releases: '#{val}'|] ) getGeckoDriverDownloadUrl :: GeckoDriverVersion -> Platform -> T.Text getGeckoDriverDownloadUrl (GeckoDriverVersion (x, y, z)) Linux = [i|https://github.com/mozilla/geckodriver/releases/download/v#{x}.#{y}.#{z}/geckodriver-v#{x}.#{y}.#{z}-linux64.tar.gz|] getGeckoDriverDownloadUrl (GeckoDriverVersion (x, y, z)) OSX = [i|https://github.com/mozilla/geckodriver/releases/download/v#{x}.#{y}.#{z}/geckodriver-v#{x}.#{y}.#{z}-macos.tar.gz|] getGeckoDriverDownloadUrl (GeckoDriverVersion (x, y, z)) Windows = [i|https://github.com/mozilla/geckodriver/releases/download/v#{x}.#{y}.#{z}/geckodriver-v#{x}.#{y}.#{z}-win32.tar.gz|] -- * Util tReadMay = readMay . convert