{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}

module Test.WebDriverWrapper.ChromeDriver (getChromeDriverIfNeeded) where

import Test.WebDriverWrapper.Constants (chromeDriverPath, downloadPath, chromeDriverVersionsUrl, chromeDriverArchIndex, chromeDriverArchivePath, chromeDriverArchiveDirectory)
import System.Directory (doesFileExist, createDirectoryIfMissing, copyFile, removeDirectoryRecursive, removeFile)
import Control.Monad (unless)
import Test.WebDriverWrapper.Helpers (download, decompressZip, evalUntillSuccess)
import Network.HTTP.Simple (parseRequest, setRequestMethod, httpLBS)
import Network.HTTP.Client.Conduit (Response(responseBody))
import Data.Aeson (eitherDecode)
import qualified Data.Aeson.KeyMap as AKM
import qualified Data.Aeson as A
import qualified Data.Vector as V
import qualified Data.Text as T
import GHC.Generics (Generic)
import System.FilePath ((</>))
import System.Process (readProcess)
import Data.Maybe (maybeToList)

-- | Checks if @chromedriver@ is in the `downloadPath`. If not, download it. 
getChromeDriverIfNeeded :: Maybe FilePath -> IO()
getChromeDriverIfNeeded :: Maybe FilePath -> IO ()
getChromeDriverIfNeeded Maybe FilePath
browserBinary = do
    FilePath
chromeDriverPath' <- IO FilePath
chromeDriverPath
    Bool
hasChromeDriver   <- FilePath -> IO Bool
doesFileExist FilePath
chromeDriverPath'
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hasChromeDriver (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe FilePath -> IO ()
getChromeDriver Maybe FilePath
browserBinary

getChromeDriver :: Maybe FilePath  -> IO()
getChromeDriver :: Maybe FilePath -> IO ()
getChromeDriver Maybe FilePath
browserBinary = do
    FilePath
dPath   <- IO FilePath
downloadPath
    FilePath
chromeVersion <- Maybe FilePath -> IO FilePath
getChromeVersion Maybe FilePath
browserBinary

    FilePath
url <- Text -> IO FilePath
getChromeDriverDownloadUrl (Text -> IO FilePath) -> Text -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
chromeVersion
    FilePath
chromeDriverArchivePath' <- IO FilePath
chromeDriverArchivePath
    FilePath
chromeDriverArchiveDirectory' <- IO FilePath
chromeDriverArchiveDirectory
    FilePath
chromeDriverPath' <- IO FilePath
chromeDriverPath

    Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dPath

    FilePath -> FilePath -> IO ()
download FilePath
url FilePath
chromeDriverArchivePath'
    FilePath -> FilePath -> IO ()
decompressZip FilePath
chromeDriverArchivePath' FilePath
dPath
    FilePath -> FilePath -> IO ()
copyFile (FilePath
chromeDriverArchiveDirectory' FilePath -> FilePath -> FilePath
</> FilePath
"chromedriver") FilePath
chromeDriverPath'
    
    FilePath -> IO ()
removeDirectoryRecursive FilePath
chromeDriverArchiveDirectory'
    FilePath -> IO ()
removeFile FilePath
chromeDriverArchivePath'


getChromeDriverDownloadUrl :: T.Text -> IO String
getChromeDriverDownloadUrl :: Text -> IO FilePath
getChromeDriverDownloadUrl Text
chromeVersion = do
    Request
requestUrl <- FilePath -> IO Request
forall (m :: * -> *). MonadThrow m => FilePath -> m Request
parseRequest FilePath
chromeDriverVersionsUrl
    let
        request :: Request
request
            = ByteString -> Request -> Request
setRequestMethod ByteString
"GET"
            Request
requestUrl
    ByteString
response <- Response ByteString -> ByteString
forall body. Response body -> body
responseBody (Response ByteString -> ByteString)
-> IO (Response ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> IO (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
httpLBS Request
request
    let
        decodedResponse :: Either FilePath ChromeDriverMain
decodedResponse = ByteString -> Either FilePath ChromeDriverMain
forall a. FromJSON a => ByteString -> Either FilePath a
eitherDecode ByteString
response :: Either String ChromeDriverMain

        allVersions :: Vector ChromeDriverVersion
allVersions = case Either FilePath ChromeDriverMain
decodedResponse of
            (Left FilePath
err)        -> FilePath -> Vector ChromeDriverVersion
forall a. HasCallStack => FilePath -> a
error FilePath
err
            (Right ChromeDriverMain
versions') ->  ChromeDriverMain -> Vector ChromeDriverVersion
versions  ChromeDriverMain
versions'
        
        versionIndex :: Maybe Int
versionIndex = (ChromeDriverVersion -> Bool)
-> Vector ChromeDriverVersion -> Maybe Int
forall a. (a -> Bool) -> Vector a -> Maybe Int
V.findIndexR ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
chromeVersion)(Text -> Bool)
-> (ChromeDriverVersion -> Text) -> ChromeDriverVersion -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ChromeDriverVersion -> Text
version) Vector ChromeDriverVersion
allVersions
        versionDownloads :: Maybe (KeyMap (Vector (KeyMap Text)))
versionDownloads = ChromeDriverVersion -> KeyMap (Vector (KeyMap Text))
downloads (ChromeDriverVersion -> KeyMap (Vector (KeyMap Text)))
-> (Int -> ChromeDriverVersion)
-> Int
-> KeyMap (Vector (KeyMap Text))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector ChromeDriverVersion
allVersions Vector ChromeDriverVersion -> Int -> ChromeDriverVersion
forall a. Vector a -> Int -> a
V.!) (Int -> KeyMap (Vector (KeyMap Text)))
-> Maybe Int -> Maybe (KeyMap (Vector (KeyMap Text)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
versionIndex

        maybeLastVersionUrl :: Maybe Text
maybeLastVersionUrl  =  do
            KeyMap (Vector (KeyMap Text))
versionDownloads' <- Maybe (KeyMap (Vector (KeyMap Text)))
versionDownloads
            Vector (KeyMap Text)
chromedriver <- Key
-> KeyMap (Vector (KeyMap Text)) -> Maybe (Vector (KeyMap Text))
forall v. Key -> KeyMap v -> Maybe v
AKM.lookup Key
"chromedriver" KeyMap (Vector (KeyMap Text))
versionDownloads'
            KeyMap Text
platform <- Vector (KeyMap Text)
chromedriver Vector (KeyMap Text) -> Int -> Maybe (KeyMap Text)
forall a. Vector a -> Int -> Maybe a
V.!? Int
chromeDriverArchIndex
            Key -> KeyMap Text -> Maybe Text
forall v. Key -> KeyMap v -> Maybe v
AKM.lookup Key
"url" KeyMap Text
platform

        url :: FilePath
url = case Maybe Text
maybeLastVersionUrl of
            Maybe Text
Nothing     -> FilePath -> FilePath
forall a. HasCallStack => FilePath -> a
error FilePath
"Couldn't get chromedriver url!"
            (Just Text
url') -> Text -> FilePath
T.unpack Text
url'
    FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
url

getChromeVersion :: Maybe FilePath -> IO String
getChromeVersion :: Maybe FilePath -> IO FilePath
getChromeVersion Maybe FilePath
executableNames = do
    let candidates :: [FilePath]
candidates = Maybe FilePath -> [FilePath]
forall a. Maybe a -> [a]
maybeToList Maybe FilePath
executableNames [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath
"google-chrome"] -- defaults to google-chrome in PATH's version. 
    FilePath
terminalOutput <- [IO FilePath] -> IO FilePath
evalUntillSuccess ([IO FilePath] -> IO FilePath) -> [IO FilePath] -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
readVersion (FilePath -> IO FilePath) -> [FilePath] -> [IO FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath]
candidates
    FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall a. HasCallStack => [a] -> a
last ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
words FilePath
terminalOutput
    where
        readVersion :: FilePath -> IO FilePath
readVersion FilePath
exec = FilePath -> [FilePath] -> FilePath -> IO FilePath
readProcess FilePath
exec [FilePath
"--version"] FilePath
""

-- To help out Aeson in parsing the JSON.
data ChromeDriverMain = ChromeDriverMain{
    ChromeDriverMain -> Text
timestamp :: T.Text,
    ChromeDriverMain -> Vector ChromeDriverVersion
versions :: V.Vector ChromeDriverVersion
}
  deriving (Int -> ChromeDriverMain -> FilePath -> FilePath
[ChromeDriverMain] -> FilePath -> FilePath
ChromeDriverMain -> FilePath
(Int -> ChromeDriverMain -> FilePath -> FilePath)
-> (ChromeDriverMain -> FilePath)
-> ([ChromeDriverMain] -> FilePath -> FilePath)
-> Show ChromeDriverMain
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> ChromeDriverMain -> FilePath -> FilePath
showsPrec :: Int -> ChromeDriverMain -> FilePath -> FilePath
$cshow :: ChromeDriverMain -> FilePath
show :: ChromeDriverMain -> FilePath
$cshowList :: [ChromeDriverMain] -> FilePath -> FilePath
showList :: [ChromeDriverMain] -> FilePath -> FilePath
Show, (forall x. ChromeDriverMain -> Rep ChromeDriverMain x)
-> (forall x. Rep ChromeDriverMain x -> ChromeDriverMain)
-> Generic ChromeDriverMain
forall x. Rep ChromeDriverMain x -> ChromeDriverMain
forall x. ChromeDriverMain -> Rep ChromeDriverMain x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChromeDriverMain -> Rep ChromeDriverMain x
from :: forall x. ChromeDriverMain -> Rep ChromeDriverMain x
$cto :: forall x. Rep ChromeDriverMain x -> ChromeDriverMain
to :: forall x. Rep ChromeDriverMain x -> ChromeDriverMain
Generic, [ChromeDriverMain] -> Value
[ChromeDriverMain] -> Encoding
ChromeDriverMain -> Bool
ChromeDriverMain -> Value
ChromeDriverMain -> Encoding
(ChromeDriverMain -> Value)
-> (ChromeDriverMain -> Encoding)
-> ([ChromeDriverMain] -> Value)
-> ([ChromeDriverMain] -> Encoding)
-> (ChromeDriverMain -> Bool)
-> ToJSON ChromeDriverMain
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ChromeDriverMain -> Value
toJSON :: ChromeDriverMain -> Value
$ctoEncoding :: ChromeDriverMain -> Encoding
toEncoding :: ChromeDriverMain -> Encoding
$ctoJSONList :: [ChromeDriverMain] -> Value
toJSONList :: [ChromeDriverMain] -> Value
$ctoEncodingList :: [ChromeDriverMain] -> Encoding
toEncodingList :: [ChromeDriverMain] -> Encoding
$comitField :: ChromeDriverMain -> Bool
omitField :: ChromeDriverMain -> Bool
A.ToJSON, Maybe ChromeDriverMain
Value -> Parser [ChromeDriverMain]
Value -> Parser ChromeDriverMain
(Value -> Parser ChromeDriverMain)
-> (Value -> Parser [ChromeDriverMain])
-> Maybe ChromeDriverMain
-> FromJSON ChromeDriverMain
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ChromeDriverMain
parseJSON :: Value -> Parser ChromeDriverMain
$cparseJSONList :: Value -> Parser [ChromeDriverMain]
parseJSONList :: Value -> Parser [ChromeDriverMain]
$comittedField :: Maybe ChromeDriverMain
omittedField :: Maybe ChromeDriverMain
A.FromJSON)

data ChromeDriverVersion = ChromeDriverVersion{
    ChromeDriverVersion -> Text
version :: T.Text,
    ChromeDriverVersion -> Text
revision :: T.Text,
    ChromeDriverVersion -> KeyMap (Vector (KeyMap Text))
downloads :: AKM.KeyMap (V.Vector (AKM.KeyMap T.Text))
}
  deriving (Int -> ChromeDriverVersion -> FilePath -> FilePath
[ChromeDriverVersion] -> FilePath -> FilePath
ChromeDriverVersion -> FilePath
(Int -> ChromeDriverVersion -> FilePath -> FilePath)
-> (ChromeDriverVersion -> FilePath)
-> ([ChromeDriverVersion] -> FilePath -> FilePath)
-> Show ChromeDriverVersion
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> ChromeDriverVersion -> FilePath -> FilePath
showsPrec :: Int -> ChromeDriverVersion -> FilePath -> FilePath
$cshow :: ChromeDriverVersion -> FilePath
show :: ChromeDriverVersion -> FilePath
$cshowList :: [ChromeDriverVersion] -> FilePath -> FilePath
showList :: [ChromeDriverVersion] -> FilePath -> FilePath
Show, (forall x. ChromeDriverVersion -> Rep ChromeDriverVersion x)
-> (forall x. Rep ChromeDriverVersion x -> ChromeDriverVersion)
-> Generic ChromeDriverVersion
forall x. Rep ChromeDriverVersion x -> ChromeDriverVersion
forall x. ChromeDriverVersion -> Rep ChromeDriverVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChromeDriverVersion -> Rep ChromeDriverVersion x
from :: forall x. ChromeDriverVersion -> Rep ChromeDriverVersion x
$cto :: forall x. Rep ChromeDriverVersion x -> ChromeDriverVersion
to :: forall x. Rep ChromeDriverVersion x -> ChromeDriverVersion
Generic, [ChromeDriverVersion] -> Value
[ChromeDriverVersion] -> Encoding
ChromeDriverVersion -> Bool
ChromeDriverVersion -> Value
ChromeDriverVersion -> Encoding
(ChromeDriverVersion -> Value)
-> (ChromeDriverVersion -> Encoding)
-> ([ChromeDriverVersion] -> Value)
-> ([ChromeDriverVersion] -> Encoding)
-> (ChromeDriverVersion -> Bool)
-> ToJSON ChromeDriverVersion
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ChromeDriverVersion -> Value
toJSON :: ChromeDriverVersion -> Value
$ctoEncoding :: ChromeDriverVersion -> Encoding
toEncoding :: ChromeDriverVersion -> Encoding
$ctoJSONList :: [ChromeDriverVersion] -> Value
toJSONList :: [ChromeDriverVersion] -> Value
$ctoEncodingList :: [ChromeDriverVersion] -> Encoding
toEncodingList :: [ChromeDriverVersion] -> Encoding
$comitField :: ChromeDriverVersion -> Bool
omitField :: ChromeDriverVersion -> Bool
A.ToJSON, Maybe ChromeDriverVersion
Value -> Parser [ChromeDriverVersion]
Value -> Parser ChromeDriverVersion
(Value -> Parser ChromeDriverVersion)
-> (Value -> Parser [ChromeDriverVersion])
-> Maybe ChromeDriverVersion
-> FromJSON ChromeDriverVersion
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ChromeDriverVersion
parseJSON :: Value -> Parser ChromeDriverVersion
$cparseJSONList :: Value -> Parser [ChromeDriverVersion]
parseJSONList :: Value -> Parser [ChromeDriverVersion]
$comittedField :: Maybe ChromeDriverVersion
omittedField :: Maybe ChromeDriverVersion
A.FromJSON)