{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ConstraintKinds #-}

module Test.Sandwich.WebDriver.Internal.Types where

import Control.Concurrent.MVar
import Control.Exception
import Data.Default
import Data.IORef
import qualified Data.Map as M
import Data.String.Interpolate
import Network.HTTP.Client (Manager)
import System.IO
import System.Process
import Test.Sandwich
import qualified Test.WebDriver as W
import qualified Test.WebDriver.Class as W
import qualified Test.WebDriver.Session as W

-- | 'Session' is just a 'String' name.
type Session = String

-- * Labels
webdriver :: Label "webdriver" WebDriver
webdriver = Label "webdriver" WebDriver
forall k (l :: Symbol) (a :: k). Label l a
Label :: Label "webdriver" WebDriver
webdriverSession :: Label "webdriverSession" WebDriverSession
webdriverSession = Label "webdriverSession" WebDriverSession
forall k (l :: Symbol) (a :: k). Label l a
Label :: Label "webdriverSession" WebDriverSession

type WebDriverContext context wd = (HasLabel context "webdriver" WebDriver, W.WebDriver (ExampleT context wd))

-- TODO: remove
class HasWebDriver a where
  getWebDriver :: a -> WebDriver

instance HasWebDriver WebDriver where
  getWebDriver :: WebDriver -> WebDriver
getWebDriver = WebDriver -> WebDriver
forall a. a -> a
id

type ToolsRoot = FilePath

data WhenToSave = Always | OnException | Never deriving (Int -> WhenToSave -> ShowS
[WhenToSave] -> ShowS
WhenToSave -> String
(Int -> WhenToSave -> ShowS)
-> (WhenToSave -> String)
-> ([WhenToSave] -> ShowS)
-> Show WhenToSave
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WhenToSave] -> ShowS
$cshowList :: [WhenToSave] -> ShowS
show :: WhenToSave -> String
$cshow :: WhenToSave -> String
showsPrec :: Int -> WhenToSave -> ShowS
$cshowsPrec :: Int -> WhenToSave -> ShowS
Show, WhenToSave -> WhenToSave -> Bool
(WhenToSave -> WhenToSave -> Bool)
-> (WhenToSave -> WhenToSave -> Bool) -> Eq WhenToSave
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WhenToSave -> WhenToSave -> Bool
$c/= :: WhenToSave -> WhenToSave -> Bool
== :: WhenToSave -> WhenToSave -> Bool
$c== :: WhenToSave -> WhenToSave -> Bool
Eq)

-- | Headless and Xvfb modes are useful because they allow you to run tests in the background, without popping up browser windows.
-- This is useful for development or for running on a CI server, and is also more reproducible since the screen resolution can be fixed.
-- In addition, Xvfb mode allows videos to be recorded of tests.
data RunMode = Normal
             -- ^ Normal Selenium behavior; will pop up a web browser.
             | RunHeadless HeadlessConfig
             -- ^ Run with a headless browser. Supports screenshots but videos will be black.
             | RunInXvfb XvfbConfig
             -- ^ Run inside <https://en.wikipedia.org/wiki/Xvfb Xvfb> so that tests run in their own X11 display.
             -- xvfb-run script must be installed and on the PATH.

data WdOptions = WdOptions {
  WdOptions -> String
toolsRoot :: ToolsRoot
  -- ^ Folder where any necessary binaries (chromedriver, Selenium, etc.) will be downloaded if needed. Required.

  , WdOptions -> Capabilities
capabilities :: W.Capabilities
  -- ^ The WebDriver capabilities to use.

  , WdOptions -> WhenToSave
saveSeleniumMessageHistory :: WhenToSave
  -- ^ When to save a record of Selenium requests and responses.

  , WdOptions -> SeleniumToUse
seleniumToUse :: SeleniumToUse
  -- ^ Which Selenium server JAR file to use.

  , WdOptions -> ChromeDriverToUse
chromeDriverToUse :: ChromeDriverToUse
  -- ^ Which chromedriver executable to use.

  , WdOptions -> GeckoDriverToUse
geckoDriverToUse :: GeckoDriverToUse
  -- ^ Which geckodriver executable to use.

  , WdOptions -> RunMode
runMode :: RunMode
  -- ^ How to handle opening the browser (in a popup window, headless, etc.).

  , WdOptions -> Maybe Manager
httpManager :: Maybe Manager
  -- ^ HTTP manager for making requests to Selenium. If not provided, one will be created for each session.

  , WdOptions -> Int
httpRetryCount :: Int
  -- ^ Number of times to retry an HTTP request if it times out.
  }

-- | How to obtain the Selenium server JAR file.
data SeleniumToUse =
  DownloadSeleniumFrom String
  -- ^ Download selenium from the given URL to the 'toolsRoot'
  | DownloadSeleniumDefault
  -- ^ Download selenium from a default location to the 'toolsRoot'
  | UseSeleniumAt FilePath
  -- ^ Use the JAR file at the given path

-- | How to obtain the chromedriver binary.
data ChromeDriverToUse =
  DownloadChromeDriverFrom String
  -- ^ Download chromedriver from the given URL to the 'toolsRoot'
  | DownloadChromeDriverVersion ChromeDriverVersion
  -- ^ Download the given chromedriver version to the 'toolsRoot'
  | DownloadChromeDriverAutodetect
  -- ^ Autodetect chromedriver to use based on the Chrome version and download it to the 'toolsRoot'
  | UseChromeDriverAt FilePath
  -- ^ Use the chromedriver at the given path

-- | How to obtain the geckodriver binary.
data GeckoDriverToUse =
  DownloadGeckoDriverFrom String
  -- ^ Download geckodriver from the given URL to the 'toolsRoot'
  | DownloadGeckoDriverVersion GeckoDriverVersion
  -- ^ Download the given geckodriver version to the 'toolsRoot'
  | DownloadGeckoDriverAutodetect
  -- ^ Autodetect geckodriver to use based on the Gecko version and download it to the 'toolsRoot'
  | UseGeckoDriverAt FilePath
  -- ^ Use the geckodriver at the given path

newtype ChromeVersion = ChromeVersion (Int, Int, Int, Int) deriving Int -> ChromeVersion -> ShowS
[ChromeVersion] -> ShowS
ChromeVersion -> String
(Int -> ChromeVersion -> ShowS)
-> (ChromeVersion -> String)
-> ([ChromeVersion] -> ShowS)
-> Show ChromeVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChromeVersion] -> ShowS
$cshowList :: [ChromeVersion] -> ShowS
show :: ChromeVersion -> String
$cshow :: ChromeVersion -> String
showsPrec :: Int -> ChromeVersion -> ShowS
$cshowsPrec :: Int -> ChromeVersion -> ShowS
Show
newtype ChromeDriverVersion = ChromeDriverVersion (Int, Int, Int, Int) deriving Int -> ChromeDriverVersion -> ShowS
[ChromeDriverVersion] -> ShowS
ChromeDriverVersion -> String
(Int -> ChromeDriverVersion -> ShowS)
-> (ChromeDriverVersion -> String)
-> ([ChromeDriverVersion] -> ShowS)
-> Show ChromeDriverVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChromeDriverVersion] -> ShowS
$cshowList :: [ChromeDriverVersion] -> ShowS
show :: ChromeDriverVersion -> String
$cshow :: ChromeDriverVersion -> String
showsPrec :: Int -> ChromeDriverVersion -> ShowS
$cshowsPrec :: Int -> ChromeDriverVersion -> ShowS
Show

newtype FirefoxVersion = FirefoxVersion (Int, Int, Int) deriving Int -> FirefoxVersion -> ShowS
[FirefoxVersion] -> ShowS
FirefoxVersion -> String
(Int -> FirefoxVersion -> ShowS)
-> (FirefoxVersion -> String)
-> ([FirefoxVersion] -> ShowS)
-> Show FirefoxVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FirefoxVersion] -> ShowS
$cshowList :: [FirefoxVersion] -> ShowS
show :: FirefoxVersion -> String
$cshow :: FirefoxVersion -> String
showsPrec :: Int -> FirefoxVersion -> ShowS
$cshowsPrec :: Int -> FirefoxVersion -> ShowS
Show
newtype GeckoDriverVersion = GeckoDriverVersion (Int, Int, Int) deriving Int -> GeckoDriverVersion -> ShowS
[GeckoDriverVersion] -> ShowS
GeckoDriverVersion -> String
(Int -> GeckoDriverVersion -> ShowS)
-> (GeckoDriverVersion -> String)
-> ([GeckoDriverVersion] -> ShowS)
-> Show GeckoDriverVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GeckoDriverVersion] -> ShowS
$cshowList :: [GeckoDriverVersion] -> ShowS
show :: GeckoDriverVersion -> String
$cshow :: GeckoDriverVersion -> String
showsPrec :: Int -> GeckoDriverVersion -> ShowS
$cshowsPrec :: Int -> GeckoDriverVersion -> ShowS
Show

data HeadlessConfig = HeadlessConfig {
  HeadlessConfig -> Maybe (Int, Int)
headlessResolution :: Maybe (Int, Int)
  -- ^ Resolution for the headless browser. Defaults to (1920, 1080)
  }

-- | Default headless config.
defaultHeadlessConfig :: HeadlessConfig
defaultHeadlessConfig = Maybe (Int, Int) -> HeadlessConfig
HeadlessConfig Maybe (Int, Int)
forall a. Maybe a
Nothing

data XvfbConfig = XvfbConfig {
  XvfbConfig -> Maybe (Int, Int)
xvfbResolution :: Maybe (Int, Int)
  -- ^ Resolution for the virtual screen. Defaults to (1920, 1080)

  , XvfbConfig -> Bool
xvfbStartFluxbox :: Bool
  -- ^ Whether to start fluxbox window manager to go with the Xvfb session. fluxbox must be on the path
  }

-- | Default Xvfb settings.
defaultXvfbConfig :: XvfbConfig
defaultXvfbConfig = Maybe (Int, Int) -> Bool -> XvfbConfig
XvfbConfig Maybe (Int, Int)
forall a. Maybe a
Nothing Bool
False

-- | The default 'WdOptions' object.
-- You should start with this and modify it using the accessors.
defaultWdOptions :: FilePath -> WdOptions
defaultWdOptions :: String -> WdOptions
defaultWdOptions String
toolsRoot = WdOptions :: String
-> Capabilities
-> WhenToSave
-> SeleniumToUse
-> ChromeDriverToUse
-> GeckoDriverToUse
-> RunMode
-> Maybe Manager
-> Int
-> WdOptions
WdOptions {
  toolsRoot :: String
toolsRoot = String
toolsRoot
  , capabilities :: Capabilities
capabilities = Capabilities
forall a. Default a => a
def
  , saveSeleniumMessageHistory :: WhenToSave
saveSeleniumMessageHistory = WhenToSave
OnException
  , seleniumToUse :: SeleniumToUse
seleniumToUse = SeleniumToUse
DownloadSeleniumDefault
  , chromeDriverToUse :: ChromeDriverToUse
chromeDriverToUse = ChromeDriverToUse
DownloadChromeDriverAutodetect
  , geckoDriverToUse :: GeckoDriverToUse
geckoDriverToUse = GeckoDriverToUse
DownloadGeckoDriverAutodetect
  , runMode :: RunMode
runMode = RunMode
Normal
  , httpManager :: Maybe Manager
httpManager = Maybe Manager
forall a. Maybe a
Nothing
  , httpRetryCount :: Int
httpRetryCount = Int
0
  }

data WebDriver = WebDriver {
  WebDriver -> String
wdName :: String
  , WebDriver
-> (Handle, Handle, ProcessHandle, String, String,
    Maybe XvfbSession)
wdWebDriver :: (Handle, Handle, ProcessHandle, FilePath, FilePath, Maybe XvfbSession)
  , WebDriver -> WdOptions
wdOptions :: WdOptions
  , WebDriver -> MVar (Map String WDSession)
wdSessionMap :: MVar (M.Map Session W.WDSession)
  , WebDriver -> WDConfig
wdConfig :: W.WDConfig
  }

data InvalidLogsException = InvalidLogsException [W.LogEntry]
  deriving (Int -> InvalidLogsException -> ShowS
[InvalidLogsException] -> ShowS
InvalidLogsException -> String
(Int -> InvalidLogsException -> ShowS)
-> (InvalidLogsException -> String)
-> ([InvalidLogsException] -> ShowS)
-> Show InvalidLogsException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InvalidLogsException] -> ShowS
$cshowList :: [InvalidLogsException] -> ShowS
show :: InvalidLogsException -> String
$cshow :: InvalidLogsException -> String
showsPrec :: Int -> InvalidLogsException -> ShowS
$cshowsPrec :: Int -> InvalidLogsException -> ShowS
Show)

instance Exception InvalidLogsException

data XvfbSession = XvfbSession { XvfbSession -> Int
xvfbDisplayNum :: Int
                               , XvfbSession -> String
xvfbXauthority :: FilePath
                               , XvfbSession -> (Int, Int)
xvfbDimensions :: (Int, Int)
                               , XvfbSession -> ProcessHandle
xvfbProcess :: ProcessHandle
                               , XvfbSession -> Maybe ProcessHandle
xvfbFluxboxProcess :: Maybe ProcessHandle }

type WebDriverSession = (Session, IORef W.WDSession)

-- | Get the 'WdOptions' associated with the 'WebDriver'.
getWdOptions :: WebDriver -> WdOptions
getWdOptions :: WebDriver -> WdOptions
getWdOptions = WebDriver -> WdOptions
wdOptions

-- | Get the X11 display number associated with the 'WebDriver'.
-- Only present if running in 'RunInXvfb' mode.
getDisplayNumber :: WebDriver -> Maybe Int
getDisplayNumber :: WebDriver -> Maybe Int
getDisplayNumber (WebDriver {wdWebDriver :: WebDriver
-> (Handle, Handle, ProcessHandle, String, String,
    Maybe XvfbSession)
wdWebDriver=(Handle
_, Handle
_, ProcessHandle
_, String
_, String
_, Just (XvfbSession {Int
xvfbDisplayNum :: Int
xvfbDisplayNum :: XvfbSession -> Int
xvfbDisplayNum}))}) = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
xvfbDisplayNum
getDisplayNumber WebDriver
_ = Maybe Int
forall a. Maybe a
Nothing

-- | Get the Xvfb session associated with the 'WebDriver', if present.
getXvfbSession :: WebDriver -> Maybe XvfbSession
getXvfbSession :: WebDriver -> Maybe XvfbSession
getXvfbSession (WebDriver {wdWebDriver :: WebDriver
-> (Handle, Handle, ProcessHandle, String, String,
    Maybe XvfbSession)
wdWebDriver=(Handle
_, Handle
_, ProcessHandle
_, String
_, String
_, Just XvfbSession
sess)}) = XvfbSession -> Maybe XvfbSession
forall a. a -> Maybe a
Just XvfbSession
sess
getXvfbSession WebDriver
_ = Maybe XvfbSession
forall a. Maybe a
Nothing

-- | Get the name of the 'WebDriver'.
getWebDriverName :: WebDriver -> String
getWebDriverName :: WebDriver -> String
getWebDriverName (WebDriver {String
wdName :: String
wdName :: WebDriver -> String
wdName}) = String
wdName

instance Show XvfbSession where
  show :: XvfbSession -> String
show (XvfbSession {Int
xvfbDisplayNum :: Int
xvfbDisplayNum :: XvfbSession -> Int
xvfbDisplayNum}) = [i|<XVFB session with server num #{xvfbDisplayNum}>|]

-- * Video stuff

-- | Default options for fast X11 video recording.
fastX11VideoOptions :: [String]
fastX11VideoOptions = [String
"-an"
                      , String
"-r", String
"30"
                      , String
"-vcodec"
                      , String
"libxvid"
                      , String
"-qscale:v", String
"1"
                      , String
"-threads", String
"0"]

-- | Default options for quality X11 video recording.
qualityX11VideoOptions :: [String]
qualityX11VideoOptions = [String
"-an"
                         , String
"-r", String
"30"
                         , String
"-vcodec", String
"libx264"
                         , String
"-preset", String
"veryslow"
                         , String
"-crf", String
"0"
                         , String
"-threads", String
"0"]

-- | Default options for AVFoundation recording (for Darwin).
defaultAvfoundationOptions :: [String]
defaultAvfoundationOptions = [String
"-r", String
"30"
                             , String
"-an"
                             , String
"-vcodec", String
"libxvid"
                             , String
"-qscale:v", String
"1"
                             , String
"-threads", String
"0"]

-- | Default options for gdigrab recording (for Windows).
defaultGdigrabOptions :: [String]
defaultGdigrabOptions = [String
"-framerate", String
"30"]

data VideoSettings = VideoSettings {
  VideoSettings -> [String]
x11grabOptions :: [String]
  -- ^ Arguments to x11grab, used with Linux.
  , VideoSettings -> [String]
avfoundationOptions :: [String]
  -- ^ Arguments to avfoundation, used with OS X.
  , VideoSettings -> [String]
gdigrabOptions :: [String]
  -- ^ Arguments to gdigrab, used with Windows.
  , VideoSettings -> Bool
hideMouseWhenRecording :: Bool
  -- ^ Hide the mouse while recording video. Linux and Windows only.
  , VideoSettings -> Bool
logToDisk :: Bool
  -- ^ Log ffmpeg stdout and stderr to disk.
  }

-- | Default video settings.
defaultVideoSettings :: VideoSettings
defaultVideoSettings = VideoSettings :: [String] -> [String] -> [String] -> Bool -> Bool -> VideoSettings
VideoSettings {
  x11grabOptions :: [String]
x11grabOptions = [String]
fastX11VideoOptions
  , avfoundationOptions :: [String]
avfoundationOptions = [String]
defaultAvfoundationOptions
  , gdigrabOptions :: [String]
gdigrabOptions = [String]
defaultGdigrabOptions
  , hideMouseWhenRecording :: Bool
hideMouseWhenRecording = Bool
False
  , logToDisk :: Bool
logToDisk = Bool
True
  }