diff --git a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Binaries.hs b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Binaries.hs index ae66c120..ca0a530d 100644 --- a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Binaries.hs +++ b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Binaries.hs @@ -144,7 +144,8 @@ downloadChromeDriverIfNecessary maybeChromePath toolsDir = runExceptT $ do 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}|] @@ -165,15 +166,18 @@ downloadAndUnzipToPath downloadPath localPath = leftOnException' $ do 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 info [i|Downloading #{downloadPath} to #{localPath}|] diff --git a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Binaries/DetectChrome.hs b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Binaries/DetectChrome.hs index 9e143547..7f6efe5d 100644 --- a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Binaries/DetectChrome.hs +++ b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Binaries/DetectChrome.hs @@ -1,4 +1,6 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} module Test.Sandwich.WebDriver.Internal.Binaries.DetectChrome ( detectChromeVersion @@ -9,23 +11,44 @@ module Test.Sandwich.WebDriver.Internal.Binaries.DetectChrome ( 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 qualified Data.Text as T +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 @@ -59,7 +82,7 @@ getChromeDriverVersion maybeChromePath = runExceptT $ do ExceptT $ getChromeDriverVersion' chromeVersion getChromeDriverVersion' :: ChromeVersion -> IO (Either T.Text ChromeDriverVersion) -getChromeDriverVersion' (ChromeVersion (w, x, y, _)) +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 @@ -68,7 +91,7 @@ getChromeDriverVersion' (ChromeVersion (w, x, y, _)) (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) + [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 @@ -78,13 +101,56 @@ getChromeDriverVersion' (ChromeVersion (w, x, y, _)) ) (do result :: LB.ByteString <- simpleHttp url - undefined + 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 (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|] +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 diff --git a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Binaries/DetectPlatform.hs b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Binaries/DetectPlatform.hs index 354537eb..a2b2dc6c 100644 --- a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Binaries/DetectPlatform.hs +++ b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Binaries/DetectPlatform.hs @@ -12,7 +12,7 @@ import qualified System.Info as SI data Platform = Linux | OSX | Windows deriving (Show, Eq) detectPlatform :: Platform -detectPlatform = case SI.os of +detectPlatform = case SI.os of "windows" -> Windows "linux" -> Linux "darwin" -> OSX diff --git a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Types.hs b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Types.hs index a8e190ae..5184f6bb 100644 --- a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Types.hs +++ b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Types.hs @@ -12,6 +12,7 @@ import Data.Default 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 @@ data GeckoDriverToUse = 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