{-# LANGUAGE CPP #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}

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 qualified Data.HashMap.Strict as HM
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

data Platform = Linux | OSX | Windows deriving (Int -> Platform -> ShowS
[Platform] -> ShowS
Platform -> String
(Int -> Platform -> ShowS)
-> (Platform -> String) -> ([Platform] -> ShowS) -> Show Platform
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
(Platform -> Platform -> Bool)
-> (Platform -> Platform -> Bool) -> Eq Platform
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
_ -> String -> Platform
forall a. HasCallStack => String -> a
error [i|Couldn't determine host platform from string: '#{SI.os}'|]

-- * Chrome

detectChromeVersion :: IO (Either T.Text ChromeVersion)
detectChromeVersion :: IO (Either Text ChromeVersion)
detectChromeVersion = IO (Either Text ChromeVersion) -> IO (Either Text ChromeVersion)
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
m (Either Text a) -> m (Either Text a)
leftOnException (IO (Either Text ChromeVersion) -> IO (Either Text ChromeVersion))
-> IO (Either Text ChromeVersion) -> IO (Either Text ChromeVersion)
forall a b. (a -> b) -> a -> b
$ ExceptT Text IO ChromeVersion -> IO (Either Text ChromeVersion)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Text IO ChromeVersion -> IO (Either Text ChromeVersion))
-> ExceptT Text IO ChromeVersion -> IO (Either Text ChromeVersion)
forall a b. (a -> b) -> a -> b
$ do
  (ExitCode
exitCode, String
stdout, String
stderr) <- IO (ExitCode, String, String)
-> ExceptT Text IO (ExitCode, String, String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ExitCode, String, String)
 -> ExceptT Text IO (ExitCode, String, String))
-> IO (ExitCode, String, String)
-> ExceptT Text IO (ExitCode, String, String)
forall a b. (a -> b) -> a -> b
$ CreateProcess -> String -> IO (ExitCode, String, String)
readCreateProcessWithExitCode (String -> CreateProcess
shell String
"google-chrome --version | grep -Eo \"[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\"") String
""

  Text
rawString <- case ExitCode
exitCode of
                 ExitFailure Int
_ -> Text -> ExceptT Text IO Text
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 -> Text -> ExceptT Text IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ExceptT Text IO Text) -> Text -> ExceptT Text IO Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip (Text -> Text) -> Text -> Text
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] -> ChromeVersion -> ExceptT Text IO ChromeVersion
forall (m :: * -> *) a. Monad m => a -> m a
return (ChromeVersion -> ExceptT Text IO ChromeVersion)
-> ChromeVersion -> ExceptT Text IO ChromeVersion
forall a b. (a -> b) -> a -> b
$ (Int, Int, Int, Int) -> ChromeVersion
ChromeVersion (Int
w, Int
x, Int
y, Int
z)
    [Text]
_ -> Text -> ExceptT Text IO ChromeVersion
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE [i|Failed to parse google-chrome version from string: '#{rawString}'|]

getChromeDriverVersion :: IO (Either T.Text ChromeDriverVersion)
getChromeDriverVersion :: IO (Either Text ChromeDriverVersion)
getChromeDriverVersion = ExceptT Text IO ChromeDriverVersion
-> IO (Either Text ChromeDriverVersion)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Text IO ChromeDriverVersion
 -> IO (Either Text ChromeDriverVersion))
-> ExceptT Text IO ChromeDriverVersion
-> IO (Either Text ChromeDriverVersion)
forall a b. (a -> b) -> a -> b
$ do
  ChromeVersion
chromeVersion <- IO (Either Text ChromeVersion) -> ExceptT Text IO ChromeVersion
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either Text ChromeVersion) -> ExceptT Text IO ChromeVersion)
-> IO (Either Text ChromeVersion) -> ExceptT Text IO ChromeVersion
forall a b. (a -> b) -> a -> b
$ IO (Either Text ChromeVersion) -> IO (Either Text ChromeVersion)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Either Text ChromeVersion)
detectChromeVersion
  IO (Either Text ChromeDriverVersion)
-> ExceptT Text IO ChromeDriverVersion
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either Text ChromeDriverVersion)
 -> ExceptT Text IO ChromeDriverVersion)
-> IO (Either Text ChromeDriverVersion)
-> ExceptT Text IO ChromeDriverVersion
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}|]
  (HttpException -> IO (Either Text ChromeDriverVersion))
-> IO (Either Text ChromeDriverVersion)
-> IO (Either Text ChromeDriverVersion)
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(HttpException
e :: HttpException) -> do
            Either Text ChromeDriverVersion
-> IO (Either Text ChromeDriverVersion)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text ChromeDriverVersion
 -> IO (Either Text ChromeDriverVersion))
-> Either Text ChromeDriverVersion
-> IO (Either Text ChromeDriverVersion)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text ChromeDriverVersion
forall a b. a -> Either a b
Left [i|Error when requesting '#{url}': '#{e}'|]
         )
         (do
             Text
result :: T.Text <- (Text -> Text
TL.toStrict (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TL.decodeUtf8) (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
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] -> Either Text ChromeDriverVersion
-> IO (Either Text ChromeDriverVersion)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text ChromeDriverVersion
 -> IO (Either Text ChromeDriverVersion))
-> Either Text ChromeDriverVersion
-> IO (Either Text ChromeDriverVersion)
forall a b. (a -> b) -> a -> b
$ ChromeDriverVersion -> Either Text ChromeDriverVersion
forall a b. b -> Either a b
Right (ChromeDriverVersion -> Either Text ChromeDriverVersion)
-> ChromeDriverVersion -> Either Text ChromeDriverVersion
forall a b. (a -> b) -> a -> b
$ (Int, Int, Int, Int) -> ChromeDriverVersion
ChromeDriverVersion (Int
w, Int
x, Int
y, Int
z)
               [Text]
_ -> Either Text ChromeDriverVersion
-> IO (Either Text ChromeDriverVersion)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text ChromeDriverVersion
 -> IO (Either Text ChromeDriverVersion))
-> Either Text ChromeDriverVersion
-> IO (Either Text ChromeDriverVersion)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text ChromeDriverVersion
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 :: IO (Either T.Text FirefoxVersion)
detectFirefoxVersion :: IO (Either Text FirefoxVersion)
detectFirefoxVersion = IO (Either Text FirefoxVersion) -> IO (Either Text FirefoxVersion)
forall (m :: * -> *) a.
(MonadIO m, MonadBaseControl IO m) =>
m (Either Text a) -> m (Either Text a)
leftOnException (IO (Either Text FirefoxVersion)
 -> IO (Either Text FirefoxVersion))
-> IO (Either Text FirefoxVersion)
-> IO (Either Text FirefoxVersion)
forall a b. (a -> b) -> a -> b
$ ExceptT Text IO FirefoxVersion -> IO (Either Text FirefoxVersion)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Text IO FirefoxVersion -> IO (Either Text FirefoxVersion))
-> ExceptT Text IO FirefoxVersion
-> IO (Either Text FirefoxVersion)
forall a b. (a -> b) -> a -> b
$ do
  (ExitCode
exitCode, String
stdout, String
stderr) <- IO (ExitCode, String, String)
-> ExceptT Text IO (ExitCode, String, String)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ExitCode, String, String)
 -> ExceptT Text IO (ExitCode, String, String))
-> IO (ExitCode, String, String)
-> ExceptT Text IO (ExitCode, String, String)
forall a b. (a -> b) -> a -> b
$ CreateProcess -> String -> IO (ExitCode, String, String)
readCreateProcessWithExitCode (String -> CreateProcess
shell String
"firefox --version | grep -Eo \"[0-9]+\\.[0-9]+(\\.[0-9]+)?\"") String
""

  Text
rawString <- case ExitCode
exitCode of
                 ExitFailure Int
_ -> Text -> ExceptT Text IO Text
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE [i|Couldn't parse firefox version. Stdout: '#{stdout}'. Stderr: '#{stderr}'|]
                 ExitCode
ExitSuccess -> Text -> ExceptT Text IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ExceptT Text IO Text) -> Text -> ExceptT Text IO Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip (Text -> Text) -> Text -> Text
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] -> FirefoxVersion -> ExceptT Text IO FirefoxVersion
forall (m :: * -> *) a. Monad m => a -> m a
return (FirefoxVersion -> ExceptT Text IO FirefoxVersion)
-> FirefoxVersion -> ExceptT Text IO FirefoxVersion
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] -> FirefoxVersion -> ExceptT Text IO FirefoxVersion
forall (m :: * -> *) a. Monad m => a -> m a
return (FirefoxVersion -> ExceptT Text IO FirefoxVersion)
-> FirefoxVersion -> ExceptT Text IO FirefoxVersion
forall a b. (a -> b) -> a -> b
$ (Int, Int, Int) -> FirefoxVersion
FirefoxVersion (Int
x, Int
y, Int
z)
    [Text]
_ -> Text -> ExceptT Text IO FirefoxVersion
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE [i|Failed to parse firefox version from string: '#{rawString}'|]


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

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