Be able to detect chrome/chromedriver for versions >= 115

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}|]

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
 

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

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