{-# LANGUAGE CPP #-}

module Test.Sandwich.WebDriver.Internal.Binaries.DetectFirefox (
  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 Network.HTTP.Client
import Network.HTTP.Client.TLS
import Safe
import System.Exit
import System.Process
import Test.Sandwich.WebDriver.Internal.Binaries.DetectPlatform
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


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