{-# 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 (Int -> Platform -> ShowS
[Platform] -> ShowS
Platform -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Platform] -> ShowS
$cshowList :: [Platform] -> ShowS
show :: Platform -> String
$cshow :: Platform -> String
showsPrec :: Int -> Platform -> ShowS
$cshowsPrec :: Int -> Platform -> ShowS
Show, Platform -> Platform -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Platform -> Platform -> Bool
$c/= :: Platform -> Platform -> Bool
== :: Platform -> Platform -> Bool
$c== :: Platform -> Platform -> Bool
Eq)

detectPlatform :: Platform
detectPlatform :: Platform
detectPlatform =  case String
SI.os of
  String
"windows" -> Platform
Windows
  String
"linux" -> Platform
Linux
  String
"darwin" -> Platform
OSX
  String
_ -> forall a. HasCallStack => String -> a
error [i|Couldn't determine host platform from string: '#{SI.os}'|]

-- * Chrome

detectChromeVersion :: Maybe FilePath -> IO (Either T.Text ChromeVersion)
detectChromeVersion :: Maybe String -> IO (Either Text ChromeVersion)
detectChromeVersion Maybe String
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
  let chromeToUse :: String
chromeToUse = forall a. a -> Maybe a -> a
fromMaybe String
"google-chrome" Maybe String
maybeChromePath
  (ExitCode
exitCode, String
stdout, String
stderr) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ CreateProcess -> String -> IO (ExitCode, String, String)
readCreateProcessWithExitCode (String -> CreateProcess
shell (String
chromeToUse forall a. Semigroup a => a -> a -> a
<> String
" --version | grep -Eo \"[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\"")) String
""

  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
$ String -> Text
T.pack String
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 String -> IO (Either Text ChromeDriverVersion)
getChromeDriverVersion Maybe String
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 String -> IO (Either Text ChromeVersion)
detectChromeVersion Maybe String
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
_)) = do
  let url :: String
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 => String -> m ByteString
simpleHttp String
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
ChromeDriverVersion (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}'|]
         )

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

-- * Firefox

detectFirefoxVersion :: Maybe FilePath -> IO (Either T.Text FirefoxVersion)
detectFirefoxVersion :: Maybe String -> IO (Either Text FirefoxVersion)
detectFirefoxVersion Maybe String
maybeFirefoxPath = 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
  let firefoxToUse :: String
firefoxToUse = forall a. a -> Maybe a -> a
fromMaybe String
"firefox" Maybe String
maybeFirefoxPath
  (ExitCode
exitCode, String
stdout, String
stderr) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ CreateProcess -> String -> IO (ExitCode, String, String)
readCreateProcessWithExitCode (String -> CreateProcess
shell (String
firefoxToUse forall a. Semigroup a => a -> a -> a
<> String
" --version | grep -Eo \"[0-9]+\\.[0-9]+(\\.[0-9]+)?\"")) String
""

  Text
rawString <- case ExitCode
exitCode of
                 ExitFailure Int
_ -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE [i|Couldn't parse firefox 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
$ String -> Text
T.pack String
stdout

  case Text -> Text -> [Text]
T.splitOn Text
"." Text
rawString of
    [Text -> Maybe Int
tReadMay -> Just Int
x, Text -> Maybe Int
tReadMay -> Just Int
y] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Int, Int, Int) -> FirefoxVersion
FirefoxVersion (Int
x, Int
y, Int
0)
    [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) -> FirefoxVersion
FirefoxVersion (Int
x, Int
y, Int
z)
    [Text]
_ -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE [i|Failed to parse firefox version from string: '#{rawString}'|]


getGeckoDriverVersion :: Maybe FilePath -> IO (Either T.Text GeckoDriverVersion)
getGeckoDriverVersion :: Maybe String -> IO (Either Text GeckoDriverVersion)
getGeckoDriverVersion Maybe String
_maybeFirefoxPath = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
  -- firefoxVersion <- ExceptT $ liftIO $ detectFirefoxVersion maybeFirefoxPath

  -- Just get the latest release on GitHub
  let url :: String
url = [i|https://api.github.com/repos/mozilla/geckodriver/releases/latest|]
  Request
req <- forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest String
url
  Manager
manager <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall (m :: * -> *). MonadIO m => m Manager
newTlsManager
  forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$
    forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(HttpException
e :: HttpException) -> 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
               Response ByteString
result <- Request -> Manager -> IO (Response ByteString)
httpLbs (Request
req { requestHeaders :: RequestHeaders
requestHeaders = (HeaderName
"User-Agent", ByteString
"foo") forall a. a -> [a] -> [a]
: (Request -> RequestHeaders
requestHeaders Request
req) }) Manager
manager
               case forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode forall a b. (a -> b) -> a -> b
$ forall body. Response body -> body
responseBody Response ByteString
result of
                 Right (A.Object (forall v. Key -> KeyMap v -> Maybe v
HM.lookup Key
"tag_name" -> Just (A.String Text
tag))) -> do
                   let parts :: [Text]
parts = Text -> Text -> [Text]
T.splitOn Text
"." forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
1 Text
tag
                   case [Text]
parts of
                     [Text -> Maybe Int
tReadMay -> Just Int
x, Text -> Maybe Int
tReadMay -> Just Int
y] -> 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) -> GeckoDriverVersion
GeckoDriverVersion (Int
x, Int
y, Int
0)
                     [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) -> GeckoDriverVersion
GeckoDriverVersion (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|Unexpected geckodriver release tag: '#{tag}'|]
                 Either String Value
val -> 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 GitHub releases: '#{val}'|]
           )


getGeckoDriverDownloadUrl :: GeckoDriverVersion -> Platform -> T.Text
getGeckoDriverDownloadUrl :: GeckoDriverVersion -> Platform -> Text
getGeckoDriverDownloadUrl (GeckoDriverVersion (Int
x, Int
y, Int
z)) Platform
Linux = [i|https://github.com/mozilla/geckodriver/releases/download/v#{x}.#{y}.#{z}/geckodriver-v#{x}.#{y}.#{z}-linux64.tar.gz|]
getGeckoDriverDownloadUrl (GeckoDriverVersion (Int
x, Int
y, Int
z)) Platform
OSX = [i|https://github.com/mozilla/geckodriver/releases/download/v#{x}.#{y}.#{z}/geckodriver-v#{x}.#{y}.#{z}-macos.tar.gz|]
getGeckoDriverDownloadUrl (GeckoDriverVersion (Int
x, Int
y, Int
z)) Platform
Windows = [i|https://github.com/mozilla/geckodriver/releases/download/v#{x}.#{y}.#{z}/geckodriver-v#{x}.#{y}.#{z}-win32.tar.gz|]

-- * Util

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