{-# LANGUAGE OverloadedLists #-}
module Test.Sandwich.WebDriver.Internal.Capabilities (
chromeCapabilities
, headlessChromeCapabilities
, firefoxCapabilities
, headlessFirefoxCapabilities
, getDefaultFirefoxProfile
) where
import Control.Monad.Trans.Control (MonadBaseControl)
import qualified Data.Aeson as A
import Data.Default
import Data.Function ((&))
import Test.WebDriver
import qualified Test.WebDriver.Firefox.Profile as FF
loggingPrefs :: A.Value
loggingPrefs :: Value
loggingPrefs = [Pair] -> Value
A.object [(Key
"browser", Value
"ALL")
, (Key
"client", Value
"WARNING")
, (Key
"driver", Value
"WARNING")
, (Key
"performance", Value
"ALL")
, (Key
"server", Value
"WARNING")
]
chromeCapabilities :: Maybe FilePath -> Capabilities
chromeCapabilities :: Maybe String -> Capabilities
chromeCapabilities Maybe String
maybeChromePath = forall a. Default a => a
def {
browser :: Browser
browser = Maybe String
-> Maybe String
-> [String]
-> [ChromeExtension]
-> Object
-> Browser
Chrome forall a. Maybe a
Nothing Maybe String
maybeChromePath [String
"--verbose"] [] forall a. Monoid a => a
mempty
, additionalCaps :: [Pair]
additionalCaps=[(Key
"loggingPrefs", Value
loggingPrefs)
, (Key
"goog:loggingPrefs", Value
loggingPrefs)]
}
headlessChromeCapabilities :: Maybe FilePath -> Capabilities
headlessChromeCapabilities :: Maybe String -> Capabilities
headlessChromeCapabilities Maybe String
maybeChromePath = forall a. Default a => a
def {
browser :: Browser
browser = Maybe String
-> Maybe String
-> [String]
-> [ChromeExtension]
-> Object
-> Browser
Chrome forall a. Maybe a
Nothing Maybe String
maybeChromePath [String
"--verbose", String
"--headless"] [] forall a. Monoid a => a
mempty
, additionalCaps :: [Pair]
additionalCaps=[(Key
"loggingPrefs", Value
loggingPrefs)
, (Key
"goog:loggingPrefs", Value
loggingPrefs)]
}
getDefaultFirefoxProfile :: MonadBaseControl IO m => FilePath -> m (FF.PreparedProfile FF.Firefox)
getDefaultFirefoxProfile :: forall (m :: * -> *).
MonadBaseControl IO m =>
String -> m (PreparedProfile Firefox)
getDefaultFirefoxProfile String
downloadDir = do
Profile Firefox
FF.defaultProfile
forall a b. a -> (a -> b) -> b
& forall a b. ToPref a => Text -> a -> Profile b -> Profile b
FF.addPref Text
"browser.download.folderList" (Int
2 :: Int)
forall a b. a -> (a -> b) -> b
& forall a b. ToPref a => Text -> a -> Profile b -> Profile b
FF.addPref Text
"browser.download.manager.showWhenStarting" Bool
False
forall a b. a -> (a -> b) -> b
& forall a b. ToPref a => Text -> a -> Profile b -> Profile b
FF.addPref Text
"browser.download.dir" String
downloadDir
forall a b. a -> (a -> b) -> b
& forall a b. ToPref a => Text -> a -> Profile b -> Profile b
FF.addPref Text
"browser.helperApps.neverAsk.saveToDisk" (String
"*" :: String)
forall a b. a -> (a -> b) -> b
& forall (m :: * -> *).
MonadBaseControl IO m =>
Profile Firefox -> m (PreparedProfile Firefox)
FF.prepareProfile
firefoxCapabilities :: Maybe FilePath -> Capabilities
firefoxCapabilities :: Maybe String -> Capabilities
firefoxCapabilities Maybe String
maybeFirefoxPath = forall a. Default a => a
def { browser :: Browser
browser = Browser
ff }
where
ff :: Browser
ff = Firefox { ffProfile :: Maybe (PreparedProfile Firefox)
ffProfile = forall a. Maybe a
Nothing
, ffLogPref :: LogLevel
ffLogPref = LogLevel
LogAll
, ffBinary :: Maybe String
ffBinary = Maybe String
maybeFirefoxPath
, ffAcceptInsecureCerts :: Maybe Bool
ffAcceptInsecureCerts = forall a. Maybe a
Nothing
}
headlessFirefoxCapabilities :: Maybe FilePath -> Capabilities
headlessFirefoxCapabilities :: Maybe String -> Capabilities
headlessFirefoxCapabilities Maybe String
maybeFirefoxPath = forall a. Default a => a
def { browser :: Browser
browser=Browser
ff, additionalCaps :: [Pair]
additionalCaps=[Pair]
additionalCaps }
where
ff :: Browser
ff = Firefox { ffProfile :: Maybe (PreparedProfile Firefox)
ffProfile = forall a. Maybe a
Nothing
, ffLogPref :: LogLevel
ffLogPref = LogLevel
LogAll
, ffBinary :: Maybe String
ffBinary = Maybe String
maybeFirefoxPath
, ffAcceptInsecureCerts :: Maybe Bool
ffAcceptInsecureCerts = forall a. Maybe a
Nothing
}
additionalCaps :: [Pair]
additionalCaps = [(Key
"moz:firefoxOptions", [Pair] -> Value
A.object [(Key
"args", Array -> Value
A.Array [Value
"-headless"])])]