{-# LANGUAGE CPP, QuasiQuotes, ScopedTypeVariables, NamedFieldPuns, OverloadedStrings, 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 Data.Convertible
import qualified Data.HashMap.Strict as HM
import Data.String.Interpolate
import qualified Data.Text as T
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
forall a b. Convertible a b => a -> b
convert 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 <- ByteString -> Text
forall a b. Convertible a b => a -> b
convert (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
forall a b. Convertible a b => a -> b
convert 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
forall a b. Convertible a b => a -> b
convert