{-# LANGUAGE OverloadedLists #-}

module Test.Sandwich.WebDriver.Internal.Capabilities (
  -- * Chrome
  chromeCapabilities
  , headlessChromeCapabilities

  -- * Firefox
  , 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")
  ]

-- * Chrome

-- | Default capabilities for regular Chrome.
-- Has the "browser" log level to "ALL" so that tests can collect browser logs.
chromeCapabilities :: Maybe FilePath -> Capabilities
chromeCapabilities :: Maybe String -> Capabilities
chromeCapabilities Maybe String
maybeChromePath = Capabilities
forall a. Default a => a
def {
  browser = Chrome Nothing maybeChromePath ["--verbose"] [] mempty
  , additionalCaps=[("loggingPrefs", loggingPrefs)
                   , ("goog:loggingPrefs", loggingPrefs)]
  }

-- | Default capabilities for headless Chrome.
headlessChromeCapabilities :: Maybe FilePath -> Capabilities
headlessChromeCapabilities :: Maybe String -> Capabilities
headlessChromeCapabilities Maybe String
maybeChromePath = Capabilities
forall a. Default a => a
def {
  browser = Chrome Nothing maybeChromePath ["--verbose", "--headless"] [] mempty
  , additionalCaps=[("loggingPrefs", loggingPrefs)
                   , ("goog:loggingPrefs", loggingPrefs)]
  }

-- * Firefox

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
    Profile Firefox
-> (Profile Firefox -> Profile Firefox) -> Profile Firefox
forall a b. a -> (a -> b) -> b
& Text -> Int -> Profile Firefox -> Profile Firefox
forall a b. ToPref a => Text -> a -> Profile b -> Profile b
FF.addPref Text
"browser.download.folderList" (Int
2 :: Int)
    Profile Firefox
-> (Profile Firefox -> Profile Firefox) -> Profile Firefox
forall a b. a -> (a -> b) -> b
& Text -> Bool -> Profile Firefox -> Profile Firefox
forall a b. ToPref a => Text -> a -> Profile b -> Profile b
FF.addPref Text
"browser.download.manager.showWhenStarting" Bool
False
    Profile Firefox
-> (Profile Firefox -> Profile Firefox) -> Profile Firefox
forall a b. a -> (a -> b) -> b
& Text -> String -> Profile Firefox -> Profile Firefox
forall a b. ToPref a => Text -> a -> Profile b -> Profile b
FF.addPref Text
"browser.download.dir" String
downloadDir
    Profile Firefox
-> (Profile Firefox -> Profile Firefox) -> Profile Firefox
forall a b. a -> (a -> b) -> b
& Text -> String -> Profile Firefox -> Profile Firefox
forall a b. ToPref a => Text -> a -> Profile b -> Profile b
FF.addPref Text
"browser.helperApps.neverAsk.saveToDisk" (String
"*" :: String)
    Profile Firefox
-> (Profile Firefox -> m (PreparedProfile Firefox))
-> m (PreparedProfile Firefox)
forall a b. a -> (a -> b) -> b
& Profile Firefox -> m (PreparedProfile Firefox)
forall (m :: * -> *).
MonadBaseControl IO m =>
Profile Firefox -> m (PreparedProfile Firefox)
FF.prepareProfile

-- | Default capabilities for regular Firefox.
firefoxCapabilities :: Maybe FilePath -> Capabilities
firefoxCapabilities :: Maybe String -> Capabilities
firefoxCapabilities Maybe String
maybeFirefoxPath = Capabilities
forall a. Default a => a
def { browser = ff }
  where
    ff :: Browser
ff = Firefox { ffProfile :: Maybe (PreparedProfile Firefox)
ffProfile = Maybe (PreparedProfile Firefox)
forall a. Maybe a
Nothing
                 , ffLogPref :: LogLevel
ffLogPref = LogLevel
LogAll
                 , ffBinary :: Maybe String
ffBinary = Maybe String
maybeFirefoxPath
                 , ffAcceptInsecureCerts :: Maybe Bool
ffAcceptInsecureCerts = Maybe Bool
forall a. Maybe a
Nothing
                 }

-- | Default capabilities for headless Firefox.
headlessFirefoxCapabilities :: Maybe FilePath -> Capabilities
headlessFirefoxCapabilities :: Maybe String -> Capabilities
headlessFirefoxCapabilities Maybe String
maybeFirefoxPath = Capabilities
forall a. Default a => a
def { browser=ff, additionalCaps=additionalCaps }
  where
    ff :: Browser
ff = Firefox { ffProfile :: Maybe (PreparedProfile Firefox)
ffProfile = Maybe (PreparedProfile Firefox)
forall a. Maybe a
Nothing
                 , ffLogPref :: LogLevel
ffLogPref = LogLevel
LogAll
                 , ffBinary :: Maybe String
ffBinary = Maybe String
maybeFirefoxPath
                 , ffAcceptInsecureCerts :: Maybe Bool
ffAcceptInsecureCerts = Maybe Bool
forall a. Maybe a
Nothing
                 }

    additionalCaps :: [Pair]
additionalCaps = [(Key
"moz:firefoxOptions", [Pair] -> Value
A.object [(Key
"args", Array -> Value
A.Array [Value
Item Array
"-headless"])])]