sandwich-webdriver 0.2.2.0 → 0.2.3.0
raw patch · 9 files changed
+285/−147 lines, 9 filesdep +bytestring
Dependencies added: bytestring
Files
- CHANGELOG.md +6/−1
- sandwich-webdriver.cabal +7/−2
- src/Test/Sandwich/WebDriver/Internal/Binaries.hs +13/−7
- src/Test/Sandwich/WebDriver/Internal/Binaries/DetectChrome.hs +157/−0
- src/Test/Sandwich/WebDriver/Internal/Binaries/DetectFirefox.hs +77/−0
- src/Test/Sandwich/WebDriver/Internal/Binaries/DetectPlatform.hs +19/−0
- src/Test/Sandwich/WebDriver/Internal/Binaries/Util.hs +0/−135
- src/Test/Sandwich/WebDriver/Internal/StartWebDriver.hs +1/−1
- src/Test/Sandwich/WebDriver/Internal/Types.hs +5/−1
CHANGELOG.md view
@@ -2,9 +2,14 @@ # Unreleased +# 0.2.3.0++* When autodetecting Chrome, look for `google-chrome-stable` as well as `google-chrome`. (It's found on NixOS.)+* Be able to detect chrome/chromedriver for versions >= 115, with the new Google JSON API.+ # 0.2.2.0 -* Fix browser path calculation in addCommandLineOptionsToWdOptions+* Fix browser path calculation in addCommandLineOptionsToWdOptions. # 0.2.1.0
sandwich-webdriver.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: sandwich-webdriver-version: 0.2.2.0+version: 0.2.3.0 synopsis: Sandwich integration with Selenium WebDriver description: Please see the <https://codedownio.github.io/sandwich/docs/extensions/sandwich-webdriver documentation>. category: Testing@@ -31,7 +31,9 @@ Test.Sandwich.WebDriver.Config Test.Sandwich.WebDriver.Internal.Action Test.Sandwich.WebDriver.Internal.Binaries- Test.Sandwich.WebDriver.Internal.Binaries.Util+ Test.Sandwich.WebDriver.Internal.Binaries.DetectChrome+ Test.Sandwich.WebDriver.Internal.Binaries.DetectFirefox+ Test.Sandwich.WebDriver.Internal.Binaries.DetectPlatform Test.Sandwich.WebDriver.Internal.Capabilities Test.Sandwich.WebDriver.Internal.Ports Test.Sandwich.WebDriver.Internal.Screenshots@@ -63,6 +65,7 @@ build-depends: aeson , base <5+ , bytestring , containers , data-default , directory@@ -139,6 +142,7 @@ build-depends: aeson , base <5+ , bytestring , containers , data-default , directory@@ -217,6 +221,7 @@ build-depends: aeson , base <5+ , bytestring , containers , data-default , directory
src/Test/Sandwich/WebDriver/Internal/Binaries.hs view
@@ -25,7 +25,9 @@ import System.IO.Temp import System.Process import Test.Sandwich.Logging-import Test.Sandwich.WebDriver.Internal.Binaries.Util+import Test.Sandwich.WebDriver.Internal.Binaries.DetectChrome+import Test.Sandwich.WebDriver.Internal.Binaries.DetectFirefox+import Test.Sandwich.WebDriver.Internal.Binaries.DetectPlatform import Test.Sandwich.WebDriver.Internal.Types import Test.Sandwich.WebDriver.Internal.Util @@ -142,7 +144,8 @@ ExceptT $ downloadChromeDriverIfNecessary' toolsDir chromeDriverVersion getChromeDriverPath :: FilePath -> ChromeDriverVersion -> FilePath-getChromeDriverPath toolsDir (ChromeDriverVersion (w, x, y, z)) = [i|#{toolsDir}/chromedrivers/#{w}.#{x}.#{y}.#{z}/#{chromeDriverExecutable}|]+getChromeDriverPath toolsDir (ChromeDriverVersionTuple (w, x, y, z)) = [i|#{toolsDir}/chromedrivers/#{w}.#{x}.#{y}.#{z}/#{chromeDriverExecutable}|]+getChromeDriverPath toolsDir (ChromeDriverVersionExactUrl (w, x, y, z) _) = [i|#{toolsDir}/chromedrivers/#{w}.#{x}.#{y}.#{z}/#{chromeDriverExecutable}|] getGeckoDriverPath :: FilePath -> GeckoDriverVersion -> FilePath getGeckoDriverPath toolsDir (GeckoDriverVersion (x, y, z)) = [i|#{toolsDir}/geckodrivers/#{x}.#{y}.#{z}/#{geckoDriverExecutable}|]@@ -163,14 +166,17 @@ liftIO $ createDirectoryIfMissing True (takeDirectory localPath) withSystemTempDirectory "sandwich-webdriver-tool-download" $ \dir -> liftIO $ do void $ readCreateProcess ((proc "curl" [T.unpack downloadPath, "-o", "temp.zip"]) { cwd = Just dir }) ""- void $ readCreateProcess ((proc "unzip" ["temp.zip"]) { cwd = Just dir }) "" - liftIO (listDirectory dir >>= filterM (\f -> executable <$> getPermissions (dir </> f))) >>= \case+ void $ readCreateProcess ((proc "unzip" ["temp.zip", "-d", "unzipped"]) { cwd = Just dir }) ""+ let unzipped = dir </> "unzipped"++ executables <- (filter (/= "") . T.splitOn "\n" . T.pack) <$> readCreateProcess (proc "find" [unzipped, "-executable", "-type", "f"]) ""+ case executables of [] -> throwIO $ userError [i|No executable found in file downloaded from #{downloadPath}|]- [x] -> renameFile (dir </> x) localPath+ [x] -> do+ copyFile (T.unpack x) localPath+ liftIO $ void $ readCreateProcess (shell [i|chmod u+x #{localPath}|]) "" xs -> throwIO $ userError [i|Found multiple executable found in file downloaded from #{downloadPath}: #{xs}|]-- liftIO $ void $ readCreateProcess (shell [i|chmod u+x #{localPath}|]) "" downloadAndUntarballToPath :: (MonadIO m, MonadBaseControl IO m, MonadLogger m) => T.Text -> FilePath -> m (Either T.Text ()) downloadAndUntarballToPath downloadPath localPath = leftOnException' $ do
+ src/Test/Sandwich/WebDriver/Internal/Binaries/DetectChrome.hs view
@@ -0,0 +1,157 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}++module Test.Sandwich.WebDriver.Internal.Binaries.DetectChrome (+ detectChromeVersion+ , getChromeDriverVersion+ , getChromeDriverDownloadUrl+ ) where++import Control.Exception+import Control.Monad.IO.Class+import Control.Monad.Trans.Except+import Data.Aeson as A+import qualified Data.ByteString.Lazy as LB+import Data.Function+import Data.Map as M hiding (mapMaybe)+import Data.Maybe (mapMaybe)+import Data.String.Interpolate+import Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL+import GHC.Generics+import Network.HTTP.Client+import Network.HTTP.Conduit (simpleHttp)+import Safe+import System.Directory (findExecutable)+import System.Exit+import qualified System.Info as SI+import System.Process+import Test.Sandwich.WebDriver.Internal.Binaries.DetectPlatform+import Test.Sandwich.WebDriver.Internal.Types+import Test.Sandwich.WebDriver.Internal.Util+++data PlatformAndUrl = PlatformAndUrl {+ platform :: Text+ , url :: Text+ } deriving (Show, Generic, FromJSON, ToJSON)++data Version = Version {+ version :: Text+ , revision :: Text+ , downloads :: Map Text [PlatformAndUrl]+ } deriving (Show, Generic, FromJSON, ToJSON)++data JsonResponse = JsonResponse {+ timestamp :: Text+ , versions :: [Version]+ } deriving (Show, Generic, FromJSON, ToJSON)++findChromeInEnvironment :: IO String+findChromeInEnvironment =+ flip fix candidates $ \loop cs -> case cs of+ [] -> pure "google-chrome" -- Give up+ (candidate:rest) -> findExecutable candidate >>= \case+ Nothing -> loop rest+ Just _ -> pure candidate+ where+ candidates = [+ "google-chrome"+ , "google-chrome-stable" -- May be found on NixOS+ ]++detectChromeVersion :: Maybe FilePath -> IO (Either T.Text ChromeVersion)+detectChromeVersion maybeChromePath = leftOnException $ runExceptT $ do+ chromeToUse <- liftIO $ maybe findChromeInEnvironment pure maybeChromePath++ (exitCode, stdout, stderr) <- liftIO $ readCreateProcessWithExitCode (shell (chromeToUse <> " --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 $ T.pack 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 :: Maybe FilePath -> IO (Either T.Text ChromeDriverVersion)+getChromeDriverVersion maybeChromePath = runExceptT $ do+ chromeVersion <- ExceptT $ liftIO $ detectChromeVersion maybeChromePath+ ExceptT $ getChromeDriverVersion' chromeVersion++getChromeDriverVersion' :: ChromeVersion -> IO (Either T.Text ChromeDriverVersion)+getChromeDriverVersion' (ChromeVersion (w, x, y, z))+ | w < 115 = 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 <- (TL.toStrict . TL.decodeUtf8) <$> simpleHttp url+ case T.splitOn "." result of+ [tReadMay -> Just w, tReadMay -> Just x, tReadMay -> Just y, tReadMay -> Just z] -> return $ Right $ ChromeDriverVersionTuple (w, x, y, z)+ _ -> return $ Left [i|Failed to parse chromedriver version from string: '#{result}'|]+ )+ | otherwise = do+ let url = [i|https://googlechromelabs.github.io/chrome-for-testing/known-good-versions-with-downloads.json|]+ handle (\(e :: HttpException) -> do+ return $ Left [i|Error when requesting '#{url}': '#{e}'|]+ )+ (do+ result :: LB.ByteString <- simpleHttp url+ case A.eitherDecode result of+ Left err -> return $ Left [i|Failed to decode response from '#{url}': #{err}|]+ Right (response :: JsonResponse) -> do+ let matchingVersions = [v | v@(Version {..}) <- versions response+ , [i|#{w}.#{x}.#{y}.|] `T.isPrefixOf` version]++ let exactMatch = headMay [x | x@(Version {..}) <- matchingVersions+ , [i|#{w}.#{x}.#{y}.#{z}|] == version]++ let versionList :: [Version]+ versionList = (case exactMatch of Nothing -> id; Just x -> (x :)) matchingVersions++ case headMay (mapMaybe extractSuitableChromeDriver versionList) of+ Nothing -> return $ Left [i|Couldn't find chromedriver associated with any Chrome release|]+ Just (tup, url) -> return $ Right $ ChromeDriverVersionExactUrl tup url+ )++extractSuitableChromeDriver :: Version -> Maybe ((Int, Int, Int, Int), Text)+extractSuitableChromeDriver (Version { version=(parseTuple -> Just tup), downloads=(M.lookup "chromedriver" -> Just platforms) }) =+ case headMay [url | PlatformAndUrl {platform, url} <- platforms+ , platform == desiredPlatform] of+ Nothing -> Nothing+ Just url -> Just (tup, url)+ where+ desiredPlatform = case (SI.os, SI.arch) of+ ("windows", "x86_64") -> "win64"+ ("windows", "i386") -> "win32"+ ("mingw32", "x86_64") -> "win64"+ ("mingw32", "i386") -> "win32"++ ("darwin", "x86_64") -> "mac-x64"+ ("darwin", "arm") -> "mac-arm64"++ ("linux", _) -> "linux64"+ ("freebsd", _) -> "linux64"+ ("netbsd", _) -> "linux64"+ ("openbsd", _) -> "linux64"++ _ -> "unknown"+extractSuitableChromeDriver _ = Nothing++parseTuple :: Text -> Maybe (Int, Int, Int, Int)+parseTuple (T.splitOn "." -> [tReadMay -> Just w, tReadMay -> Just x, tReadMay -> Just y, tReadMay -> Just z]) = Just (w, x, y, z)+parseTuple _ = Nothing++getChromeDriverDownloadUrl :: ChromeDriverVersion -> Platform -> T.Text+getChromeDriverDownloadUrl (ChromeDriverVersionTuple (w, x, y, z)) Linux = [i|https://chromedriver.storage.googleapis.com/#{w}.#{x}.#{y}.#{z}/chromedriver_linux64.zip|]+getChromeDriverDownloadUrl (ChromeDriverVersionTuple (w, x, y, z)) OSX = [i|https://chromedriver.storage.googleapis.com/#{w}.#{x}.#{y}.#{z}/chromedriver_mac64.zip|]+getChromeDriverDownloadUrl (ChromeDriverVersionTuple (w, x, y, z)) Windows = [i|https://chromedriver.storage.googleapis.com/#{w}.#{x}.#{y}.#{z}/chromedriver_win32.zip|]+getChromeDriverDownloadUrl (ChromeDriverVersionExactUrl _ url) _ = url++-- * Util++tReadMay = readMay . T.unpack
+ src/Test/Sandwich/WebDriver/Internal/Binaries/DetectFirefox.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE CPP #-}++module Test.Sandwich.WebDriver.Internal.Binaries.DetectFirefox (+ 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 Network.HTTP.Client+import Network.HTTP.Client.TLS+import Safe+import System.Exit+import System.Process+import Test.Sandwich.WebDriver.Internal.Binaries.DetectPlatform+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+++detectFirefoxVersion :: Maybe FilePath -> IO (Either T.Text FirefoxVersion)+detectFirefoxVersion maybeFirefoxPath = leftOnException $ runExceptT $ do+ let firefoxToUse = fromMaybe "firefox" maybeFirefoxPath+ (exitCode, stdout, stderr) <- liftIO $ readCreateProcessWithExitCode (shell (firefoxToUse <> " --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 $ T.pack 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 :: Maybe FilePath -> IO (Either T.Text GeckoDriverVersion)+getGeckoDriverVersion _maybeFirefoxPath = runExceptT $ do+ -- firefoxVersion <- ExceptT $ liftIO $ detectFirefoxVersion maybeFirefoxPath++ -- 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 . T.unpack
+ src/Test/Sandwich/WebDriver/Internal/Binaries/DetectPlatform.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE CPP #-}++module Test.Sandwich.WebDriver.Internal.Binaries.DetectPlatform (+ detectPlatform+ , Platform(..)+ ) where++import Data.String.Interpolate+import qualified System.Info as SI+++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}'|]
− src/Test/Sandwich/WebDriver/Internal/Binaries/Util.hs
@@ -1,135 +0,0 @@-{-# 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 (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 :: Maybe FilePath -> IO (Either T.Text ChromeVersion)-detectChromeVersion maybeChromePath = leftOnException $ runExceptT $ do- let chromeToUse = fromMaybe "google-chrome" maybeChromePath- (exitCode, stdout, stderr) <- liftIO $ readCreateProcessWithExitCode (shell (chromeToUse <> " --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 $ T.pack 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 :: Maybe FilePath -> IO (Either T.Text ChromeDriverVersion)-getChromeDriverVersion maybeChromePath = runExceptT $ do- chromeVersion <- ExceptT $ liftIO $ detectChromeVersion maybeChromePath- 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 <- (TL.toStrict . TL.decodeUtf8) <$> 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 :: Maybe FilePath -> IO (Either T.Text FirefoxVersion)-detectFirefoxVersion maybeFirefoxPath = leftOnException $ runExceptT $ do- let firefoxToUse = fromMaybe "firefox" maybeFirefoxPath- (exitCode, stdout, stderr) <- liftIO $ readCreateProcessWithExitCode (shell (firefoxToUse <> " --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 $ T.pack 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 :: Maybe FilePath -> IO (Either T.Text GeckoDriverVersion)-getGeckoDriverVersion _maybeFirefoxPath = runExceptT $ do- -- firefoxVersion <- ExceptT $ liftIO $ detectFirefoxVersion maybeFirefoxPath-- -- 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 . T.unpack
src/Test/Sandwich/WebDriver/Internal/StartWebDriver.hs view
@@ -33,7 +33,7 @@ import System.Process import Test.Sandwich import Test.Sandwich.WebDriver.Internal.Binaries-import Test.Sandwich.WebDriver.Internal.Binaries.Util (detectChromeVersion)+import Test.Sandwich.WebDriver.Internal.Binaries.DetectChrome (detectChromeVersion) import Test.Sandwich.WebDriver.Internal.Ports import Test.Sandwich.WebDriver.Internal.Types import Test.Sandwich.WebDriver.Internal.Util
src/Test/Sandwich/WebDriver/Internal/Types.hs view
@@ -12,6 +12,7 @@ import Data.IORef import qualified Data.Map as M import Data.String.Interpolate+import Data.Text as T import Network.HTTP.Client (Manager) import System.IO import System.Process@@ -121,7 +122,10 @@ deriving Show newtype ChromeVersion = ChromeVersion (Int, Int, Int, Int) deriving Show-newtype ChromeDriverVersion = ChromeDriverVersion (Int, Int, Int, Int) deriving Show+data ChromeDriverVersion =+ ChromeDriverVersionTuple (Int, Int, Int, Int)+ | ChromeDriverVersionExactUrl (Int, Int, Int, Int) Text+ deriving Show newtype FirefoxVersion = FirefoxVersion (Int, Int, Int) deriving Show newtype GeckoDriverVersion = GeckoDriverVersion (Int, Int, Int) deriving Show