{-# 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 {
  PlatformAndUrl -> Text
platform :: Text
  , PlatformAndUrl -> Text
url :: Text
  } deriving (Int -> PlatformAndUrl -> ShowS
[PlatformAndUrl] -> ShowS
PlatformAndUrl -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PlatformAndUrl] -> ShowS
$cshowList :: [PlatformAndUrl] -> ShowS
show :: PlatformAndUrl -> [Char]
$cshow :: PlatformAndUrl -> [Char]
showsPrec :: Int -> PlatformAndUrl -> ShowS
$cshowsPrec :: Int -> PlatformAndUrl -> ShowS
Show, forall x. Rep PlatformAndUrl x -> PlatformAndUrl
forall x. PlatformAndUrl -> Rep PlatformAndUrl x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PlatformAndUrl x -> PlatformAndUrl
$cfrom :: forall x. PlatformAndUrl -> Rep PlatformAndUrl x
Generic, Value -> Parser [PlatformAndUrl]
Value -> Parser PlatformAndUrl
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PlatformAndUrl]
$cparseJSONList :: Value -> Parser [PlatformAndUrl]
parseJSON :: Value -> Parser PlatformAndUrl
$cparseJSON :: Value -> Parser PlatformAndUrl
FromJSON, [PlatformAndUrl] -> Encoding
[PlatformAndUrl] -> Value
PlatformAndUrl -> Encoding
PlatformAndUrl -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PlatformAndUrl] -> Encoding
$ctoEncodingList :: [PlatformAndUrl] -> Encoding
toJSONList :: [PlatformAndUrl] -> Value
$ctoJSONList :: [PlatformAndUrl] -> Value
toEncoding :: PlatformAndUrl -> Encoding
$ctoEncoding :: PlatformAndUrl -> Encoding
toJSON :: PlatformAndUrl -> Value
$ctoJSON :: PlatformAndUrl -> Value
ToJSON)

data Version = Version {
  Version -> Text
version :: Text
  , Version -> Text
revision :: Text
  , Version -> Map Text [PlatformAndUrl]
downloads :: Map Text [PlatformAndUrl]
  } deriving (Int -> Version -> ShowS
[Version] -> ShowS
Version -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Version] -> ShowS
$cshowList :: [Version] -> ShowS
show :: Version -> [Char]
$cshow :: Version -> [Char]
showsPrec :: Int -> Version -> ShowS
$cshowsPrec :: Int -> Version -> ShowS
Show, forall x. Rep Version x -> Version
forall x. Version -> Rep Version x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Version x -> Version
$cfrom :: forall x. Version -> Rep Version x
Generic, Value -> Parser [Version]
Value -> Parser Version
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Version]
$cparseJSONList :: Value -> Parser [Version]
parseJSON :: Value -> Parser Version
$cparseJSON :: Value -> Parser Version
FromJSON, [Version] -> Encoding
[Version] -> Value
Version -> Encoding
Version -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Version] -> Encoding
$ctoEncodingList :: [Version] -> Encoding
toJSONList :: [Version] -> Value
$ctoJSONList :: [Version] -> Value
toEncoding :: Version -> Encoding
$ctoEncoding :: Version -> Encoding
toJSON :: Version -> Value
$ctoJSON :: Version -> Value
ToJSON)

data JsonResponse = JsonResponse {
  JsonResponse -> Text
timestamp :: Text
  , JsonResponse -> [Version]
versions :: [Version]
  } deriving (Int -> JsonResponse -> ShowS
[JsonResponse] -> ShowS
JsonResponse -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [JsonResponse] -> ShowS
$cshowList :: [JsonResponse] -> ShowS
show :: JsonResponse -> [Char]
$cshow :: JsonResponse -> [Char]
showsPrec :: Int -> JsonResponse -> ShowS
$cshowsPrec :: Int -> JsonResponse -> ShowS
Show, forall x. Rep JsonResponse x -> JsonResponse
forall x. JsonResponse -> Rep JsonResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JsonResponse x -> JsonResponse
$cfrom :: forall x. JsonResponse -> Rep JsonResponse x
Generic, Value -> Parser [JsonResponse]
Value -> Parser JsonResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [JsonResponse]
$cparseJSONList :: Value -> Parser [JsonResponse]
parseJSON :: Value -> Parser JsonResponse
$cparseJSON :: Value -> Parser JsonResponse
FromJSON, [JsonResponse] -> Encoding
[JsonResponse] -> Value
JsonResponse -> Encoding
JsonResponse -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [JsonResponse] -> Encoding
$ctoEncodingList :: [JsonResponse] -> Encoding
toJSONList :: [JsonResponse] -> Value
$ctoJSONList :: [JsonResponse] -> Value
toEncoding :: JsonResponse -> Encoding
$ctoEncoding :: JsonResponse -> Encoding
toJSON :: JsonResponse -> Value
$ctoJSON :: JsonResponse -> Value
ToJSON)

findChromeInEnvironment :: IO String
findChromeInEnvironment :: IO [Char]
findChromeInEnvironment =
  forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (a -> a) -> a
fix [[Char]]
candidates forall a b. (a -> b) -> a -> b
$ \[[Char]] -> IO [Char]
loop [[Char]]
cs -> case [[Char]]
cs of
    [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
"google-chrome" -- Give up
    ([Char]
candidate:[[Char]]
rest) -> [Char] -> IO (Maybe [Char])
findExecutable [Char]
candidate forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe [Char]
Nothing -> [[Char]] -> IO [Char]
loop [[Char]]
rest
      Just [Char]
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
candidate
  where
    candidates :: [[Char]]
candidates = [
      [Char]
"google-chrome"
      , [Char]
"google-chrome-stable" -- May be found on NixOS
      ]

detectChromeVersion :: Maybe FilePath -> IO (Either T.Text ChromeVersion)
detectChromeVersion :: Maybe [Char] -> IO (Either Text ChromeVersion)
detectChromeVersion Maybe [Char]
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
  [Char]
chromeToUse <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO [Char]
findChromeInEnvironment forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [Char]
maybeChromePath

  (ExitCode
exitCode, [Char]
stdout, [Char]
stderr) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ CreateProcess -> [Char] -> IO (ExitCode, [Char], [Char])
readCreateProcessWithExitCode ([Char] -> CreateProcess
shell ([Char]
chromeToUse forall a. Semigroup a => a -> a -> a
<> [Char]
" --version | grep -Eo \"[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\"")) [Char]
""

  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
$ [Char] -> Text
T.pack [Char]
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 [Char] -> IO (Either Text ChromeDriverVersion)
getChromeDriverVersion Maybe [Char]
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 [Char] -> IO (Either Text ChromeVersion)
detectChromeVersion Maybe [Char]
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
z))
  | Int
w forall a. Ord a => a -> a -> Bool
< Int
115 = do
      let url :: [Char]
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 => [Char] -> m ByteString
simpleHttp [Char]
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
ChromeDriverVersionTuple (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}'|]
             )
  | Bool
otherwise = do
      let url :: [Char]
url = [i|https://googlechromelabs.github.io/chrome-for-testing/known-good-versions-with-downloads.json|]
      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
                 ByteString
result :: LB.ByteString <- forall (m :: * -> *). MonadIO m => [Char] -> m ByteString
simpleHttp [Char]
url
                 case forall a. FromJSON a => ByteString -> Either [Char] a
A.eitherDecode ByteString
result of
                   Left [Char]
err -> 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 response from '#{url}': #{err}|]
                   Right (JsonResponse
response :: JsonResponse) -> do
                     let matchingVersions :: [Version]
matchingVersions = [Version
v | v :: Version
v@(Version {Text
Map Text [PlatformAndUrl]
downloads :: Map Text [PlatformAndUrl]
revision :: Text
version :: Text
downloads :: Version -> Map Text [PlatformAndUrl]
revision :: Version -> Text
version :: Version -> Text
..}) <- JsonResponse -> [Version]
versions JsonResponse
response
                                               , [i|#{w}.#{x}.#{y}.|] Text -> Text -> Bool
`T.isPrefixOf` Text
version]

                     let exactMatch :: Maybe Version
exactMatch = forall a. [a] -> Maybe a
headMay [Version
x | x :: Version
x@(Version {Text
Map Text [PlatformAndUrl]
downloads :: Map Text [PlatformAndUrl]
revision :: Text
version :: Text
downloads :: Version -> Map Text [PlatformAndUrl]
revision :: Version -> Text
version :: Version -> Text
..}) <- [Version]
matchingVersions
                                               , [i|#{w}.#{x}.#{y}.#{z}|] forall a. Eq a => a -> a -> Bool
== Text
version]

                     let versionList :: [Version]
                         versionList :: [Version]
versionList = (case Maybe Version
exactMatch of Maybe Version
Nothing -> forall a. a -> a
id; Just Version
x -> (Version
x forall a. a -> [a] -> [a]
:)) [Version]
matchingVersions

                     case forall a. [a] -> Maybe a
headMay (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Version -> Maybe ((Int, Int, Int, Int), Text)
extractSuitableChromeDriver [Version]
versionList) of
                       Maybe ((Int, Int, Int, Int), Text)
Nothing -> 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|Couldn't find chromedriver associated with any Chrome release|]
                       Just ((Int, Int, Int, Int)
tup, Text
url) -> 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) -> Text -> ChromeDriverVersion
ChromeDriverVersionExactUrl (Int, Int, Int, Int)
tup Text
url
             )

extractSuitableChromeDriver :: Version -> Maybe ((Int, Int, Int, Int), Text)
extractSuitableChromeDriver :: Version -> Maybe ((Int, Int, Int, Int), Text)
extractSuitableChromeDriver (Version { version :: Version -> Text
version=(Text -> Maybe (Int, Int, Int, Int)
parseTuple -> Just (Int, Int, Int, Int)
tup), downloads :: Version -> Map Text [PlatformAndUrl]
downloads=(forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
"chromedriver" -> Just [PlatformAndUrl]
platforms) }) =
  case forall a. [a] -> Maybe a
headMay [Text
url | PlatformAndUrl {Text
platform :: Text
platform :: PlatformAndUrl -> Text
platform, Text
url :: Text
url :: PlatformAndUrl -> Text
url} <- [PlatformAndUrl]
platforms
                    , Text
platform forall a. Eq a => a -> a -> Bool
== Text
desiredPlatform] of
    Maybe Text
Nothing -> forall a. Maybe a
Nothing
    Just Text
url -> forall a. a -> Maybe a
Just ((Int, Int, Int, Int)
tup, Text
url)
  where
    desiredPlatform :: Text
desiredPlatform = case ([Char]
SI.os, [Char]
SI.arch) of
      ([Char]
"windows", [Char]
"x86_64") -> Text
"win64"
      ([Char]
"windows", [Char]
"i386") -> Text
"win32"
      ([Char]
"mingw32", [Char]
"x86_64") -> Text
"win64"
      ([Char]
"mingw32", [Char]
"i386") -> Text
"win32"

      ([Char]
"darwin", [Char]
"x86_64") -> Text
"mac-x64"
      ([Char]
"darwin", [Char]
"arm") -> Text
"mac-arm64"

      ([Char]
"linux", [Char]
_) -> Text
"linux64"
      ([Char]
"freebsd", [Char]
_) -> Text
"linux64"
      ([Char]
"netbsd", [Char]
_) -> Text
"linux64"
      ([Char]
"openbsd", [Char]
_) -> Text
"linux64"

      ([Char], [Char])
_ -> Text
"unknown"
extractSuitableChromeDriver Version
_ = forall a. Maybe a
Nothing

parseTuple :: Text -> Maybe (Int, Int, Int, Int)
parseTuple :: Text -> Maybe (Int, Int, Int, Int)
parseTuple (Text -> Text -> [Text]
T.splitOn Text
"." -> [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 a. a -> Maybe a
Just (Int
w, Int
x, Int
y, Int
z)
parseTuple Text
_ = forall a. Maybe a
Nothing

getChromeDriverDownloadUrl :: ChromeDriverVersion -> Platform -> T.Text
getChromeDriverDownloadUrl :: ChromeDriverVersion -> Platform -> Text
getChromeDriverDownloadUrl (ChromeDriverVersionTuple (Int
w, Int
x, Int
y, Int
z)) Platform
Linux = [i|https://chromedriver.storage.googleapis.com/#{w}.#{x}.#{y}.#{z}/chromedriver_linux64.zip|]
getChromeDriverDownloadUrl (ChromeDriverVersionTuple (Int
w, Int
x, Int
y, Int
z)) Platform
OSX = [i|https://chromedriver.storage.googleapis.com/#{w}.#{x}.#{y}.#{z}/chromedriver_mac64.zip|]
getChromeDriverDownloadUrl (ChromeDriverVersionTuple (Int
w, Int
x, Int
y, Int
z)) Platform
Windows = [i|https://chromedriver.storage.googleapis.com/#{w}.#{x}.#{y}.#{z}/chromedriver_win32.zip|]
getChromeDriverDownloadUrl (ChromeDriverVersionExactUrl (Int, Int, Int, Int)
_ Text
url) Platform
_ = Text
url

-- * Util

tReadMay :: Text -> Maybe Int
tReadMay = forall a. Read a => [Char] -> Maybe a
readMay forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack