Util.hs

{-# 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 (Show, Eq)

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

-- * Chrome

detectChromeVersion :: IO (Either T.Text ChromeVersion)
detectChromeVersion = leftOnException $ runExceptT $ do
  (exitCode, stdout, stderr) <- liftIO $ readCreateProcessWithExitCode (shell "google-chrome --version | grep -Eo \"[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\"") ""

  rawString <- case exitCode of
                 ExitFailure _ -> throwE [i|Couldn't parse google-chrome version. Stdout: '#{stdout}'. Stderr: '#{stderr}'|]
                 ExitSuccess -> return $ T.strip $ convert stdout

  case T.splitOn "." rawString of
    [tReadMay -> Just w, tReadMay -> Just x, tReadMay -> Just y, tReadMay -> Just z] -> return $ ChromeVersion (w, x, y, z)
    _ -> throwE [i|Failed to parse google-chrome version from string: '#{rawString}'|]

getChromeDriverVersion :: IO (Either T.Text ChromeDriverVersion)
getChromeDriverVersion = runExceptT $ do
  chromeVersion <- ExceptT $ liftIO detectChromeVersion
  ExceptT $ getChromeDriverVersion' chromeVersion

getChromeDriverVersion' :: ChromeVersion -> IO (Either T.Text ChromeDriverVersion)
getChromeDriverVersion' (ChromeVersion (w, x, y, _)) = do
  let url = [i|https://chromedriver.storage.googleapis.com/LATEST_RELEASE_#{w}.#{x}.#{y}|]
  handle (\(e :: HttpException) -> do
            return $ Left [i|Error when requesting '#{url}': '#{e}'|]
         )
         (do
             result :: T.Text <- convert <$> 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)
               _ -> return $ Left [i|Failed to parse chromedriver version from string: '#{result}'|]
         )

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

-- * Firefox

detectFirefoxVersion :: IO (Either T.Text FirefoxVersion)
detectFirefoxVersion = leftOnException $ runExceptT $ do
  (exitCode, stdout, stderr) <- liftIO $ readCreateProcessWithExitCode (shell "firefox --version | grep -Eo \"[0-9]+\\.[0-9]+(\\.[0-9]+)?\"") ""

  rawString <- case exitCode of
                 ExitFailure _ -> throwE [i|Couldn't parse firefox version. Stdout: '#{stdout}'. Stderr: '#{stderr}'|]
                 ExitSuccess -> return $ T.strip $ convert stdout

  case T.splitOn "." rawString of
    [tReadMay -> Just x, tReadMay -> Just y] -> return $ FirefoxVersion (x, y, 0)
    [tReadMay -> Just x, tReadMay -> Just y, tReadMay -> Just z] -> return $ FirefoxVersion (x, y, z)
    _ -> throwE [i|Failed to parse firefox version from string: '#{rawString}'|]


getGeckoDriverVersion :: IO (Either T.Text GeckoDriverVersion)
getGeckoDriverVersion = runExceptT $ do
  -- firefoxVersion <- ExceptT $ liftIO detectFirefoxVersion

  -- Just get the latest release on GitHub
  let url = [i|https://api.github.com/repos/mozilla/geckodriver/releases/latest|]
  req <- parseRequest url
  manager <- liftIO newTlsManager
  ExceptT $
    handle (\(e :: HttpException) -> return $ Left [i|Error when requesting '#{url}': '#{e}'|])
           (do
               result <- httpLbs (req { requestHeaders = ("User-Agent", "foo") : (requestHeaders req) }) manager
               case A.eitherDecode $ responseBody result of
                 Right (A.Object (HM.lookup "tag_name" -> Just (A.String tag))) -> do
                   let parts = T.splitOn "." $ T.drop 1 tag
                   case parts of
                     [tReadMay -> Just x, tReadMay -> Just y] -> return $ Right $ GeckoDriverVersion (x, y, 0)
                     [tReadMay -> Just x, tReadMay -> Just y, tReadMay -> Just z] -> return $ Right $ GeckoDriverVersion (x, y, z)
                     _ -> return $ Left [i|Unexpected geckodriver release tag: '#{tag}'|]
                 val -> return $ Left [i|Failed to decode GitHub releases: '#{val}'|]
           )


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

-- * Util

tReadMay = readMay . convert