{-# LANGUAGE OverloadedStrings #-}
module Test.WebDriverWrapper.GeckoDriver (getGeckoDriverIfNeeded) where
import qualified Data.Text as T
import Network.HTTP.Simple (setRequestMethod, httpLBS, parseRequest, setRequestHeader)
import Test.WebDriverWrapper.Helpers (download, decompressGecko)
import Test.WebDriverWrapper.Constants (getGeckoDriverDownloadUrl, geckoDriverVersionSource, geckoArchivePath, geckoDriverPath, downloadPath)
import Network.HTTP.Client.Conduit (Response(responseBody))
import Data.Aeson (eitherDecode)
import Network.HTTP.Types (hUserAgent)
import qualified Data.Aeson.KeyMap as AKM
import qualified Data.Aeson as A
import System.Directory (createDirectoryIfMissing, removeFile, doesFileExist)
import Control.Monad (unless)
getGeckoDriverIfNeeded :: IO ()
getGeckoDriverIfNeeded :: IO ()
getGeckoDriverIfNeeded = do
FilePath
geckoPath <- IO FilePath
geckoDriverPath
Bool
hasGeckoDriver <- FilePath -> IO Bool
doesFileExist FilePath
geckoPath
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
hasGeckoDriver IO ()
getGeckoDriver
getGeckoDriver :: IO()
getGeckoDriver :: IO ()
getGeckoDriver = do
FilePath
version <- IO FilePath
getGeckoDriverVersion
FilePath
dPath <- IO FilePath
downloadPath
FilePath
geckoArchivePath' <- IO FilePath
geckoArchivePath
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dPath
let url :: FilePath
url = FilePath -> FilePath
getGeckoDriverDownloadUrl FilePath
version
FilePath -> FilePath -> IO ()
download FilePath
url FilePath
geckoArchivePath'
FilePath -> FilePath -> IO ()
decompressGecko FilePath
geckoArchivePath' FilePath
dPath
FilePath -> IO ()
removeFile FilePath
geckoArchivePath'
getGeckoDriverVersion :: IO String
getGeckoDriverVersion :: IO FilePath
getGeckoDriverVersion = do
Request
requestUrl <- FilePath -> IO Request
forall (m :: * -> *). MonadThrow m => FilePath -> m Request
parseRequest FilePath
versionAPI
let
request :: Request
request
= ByteString -> Request -> Request
setRequestMethod ByteString
"GET"
(Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ HeaderName -> [ByteString] -> Request -> Request
setRequestHeader HeaderName
hUserAgent [ByteString
"cli"]
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
version' :: Either FilePath Object
version' = ByteString -> Either FilePath Object
forall a. FromJSON a => ByteString -> Either FilePath a
eitherDecode ByteString
response :: Either String A.Object
maybeVersion :: Maybe Value
maybeVersion = case Either FilePath Object
version' of
(Left FilePath
err) -> FilePath -> Maybe Value
forall a. HasCallStack => FilePath -> a
error FilePath
err
(Right Object
version'') -> Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
AKM.lookup Key
"tag_name" Object
version''
version :: Text
version = case Maybe Value
maybeVersion of
Maybe Value
Nothing -> FilePath -> Text
forall a. HasCallStack => FilePath -> a
error FilePath
"Couldn't parse response from Test.WebDriverWrapper.GeckoDriver's version API"
(Just (A.String Text
v))-> Text
v
(Just Value
_) -> FilePath -> Text
forall a. HasCallStack => FilePath -> a
error FilePath
"\"tag_name\" key isn't returning a string. Maybe Test.WebDriverWrapper.GeckoDriver's version API changed, consider opening a github issue."
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
$ Text -> FilePath
T.unpack Text
version
where
versionAPI :: FilePath
versionAPI = FilePath
geckoDriverVersionSource