{-# 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 = forall {k} (l :: Symbol) (a :: k). Label l a
Label :: Label "webdriver" WebDriver
webdriverSession :: Label "webdriverSession" 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 = forall a. a -> a
id

type ToolsRoot = FilePath

data WhenToSave = Always | OnException | Never deriving (Int -> WhenToSave -> ShowS
[WhenToSave] -> ShowS
WhenToSave -> String
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
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 -> Maybe String
chromeBinaryPath :: Maybe FilePath
  -- ^ Which chrome binary to use.
  , WdOptions -> ChromeDriverToUse
chromeDriverToUse :: ChromeDriverToUse
  -- ^ Which chromedriver executable to use.

  , WdOptions -> Maybe String
firefoxBinaryPath :: Maybe FilePath
  -- ^ Which firefox binary 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
  deriving Int -> SeleniumToUse -> ShowS
[SeleniumToUse] -> ShowS
SeleniumToUse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SeleniumToUse] -> ShowS
$cshowList :: [SeleniumToUse] -> ShowS
show :: SeleniumToUse -> String
$cshow :: SeleniumToUse -> String
showsPrec :: Int -> SeleniumToUse -> ShowS
$cshowsPrec :: Int -> SeleniumToUse -> ShowS
Show

-- | 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 (Maybe FilePath)
  -- ^ Autodetect chromedriver to use based on the Chrome version and download it to the 'toolsRoot'
  -- Pass the path to the Chrome binary, or else it will be found by looking for google-chrome on the PATH.
  | UseChromeDriverAt FilePath
  -- ^ Use the chromedriver at the given path
  deriving Int -> ChromeDriverToUse -> ShowS
[ChromeDriverToUse] -> ShowS
ChromeDriverToUse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChromeDriverToUse] -> ShowS
$cshowList :: [ChromeDriverToUse] -> ShowS
show :: ChromeDriverToUse -> String
$cshow :: ChromeDriverToUse -> String
showsPrec :: Int -> ChromeDriverToUse -> ShowS
$cshowsPrec :: Int -> ChromeDriverToUse -> ShowS
Show

-- | 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 (Maybe FilePath)
  -- ^ Autodetect geckodriver to use based on the Gecko version and download it to the 'toolsRoot'
  -- Pass the path to the Firefox binary, or else it will be found by looking for firefox on the PATH.
  | UseGeckoDriverAt FilePath
  -- ^ Use the geckodriver at the given path
  deriving Int -> GeckoDriverToUse -> ShowS
[GeckoDriverToUse] -> ShowS
GeckoDriverToUse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GeckoDriverToUse] -> ShowS
$cshowList :: [GeckoDriverToUse] -> ShowS
show :: GeckoDriverToUse -> String
$cshow :: GeckoDriverToUse -> String
showsPrec :: Int -> GeckoDriverToUse -> ShowS
$cshowsPrec :: Int -> GeckoDriverToUse -> ShowS
Show

newtype ChromeVersion = ChromeVersion (Int, Int, Int, Int) deriving Int -> ChromeVersion -> ShowS
[ChromeVersion] -> ShowS
ChromeVersion -> String
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
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
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
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 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 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 {
  toolsRoot :: String
toolsRoot = String
toolsRoot
  , capabilities :: Capabilities
capabilities = forall a. Default a => a
def
  , saveSeleniumMessageHistory :: WhenToSave
saveSeleniumMessageHistory = WhenToSave
OnException
  , seleniumToUse :: SeleniumToUse
seleniumToUse = SeleniumToUse
DownloadSeleniumDefault
  , chromeBinaryPath :: Maybe String
chromeBinaryPath = forall a. Maybe a
Nothing
  , chromeDriverToUse :: ChromeDriverToUse
chromeDriverToUse = Maybe String -> ChromeDriverToUse
DownloadChromeDriverAutodetect forall a. Maybe a
Nothing
  , firefoxBinaryPath :: Maybe String
firefoxBinaryPath = forall a. Maybe a
Nothing
  , geckoDriverToUse :: GeckoDriverToUse
geckoDriverToUse = Maybe String -> GeckoDriverToUse
DownloadGeckoDriverAutodetect forall a. Maybe a
Nothing
  , runMode :: RunMode
runMode = RunMode
Normal
  , httpManager :: Maybe Manager
httpManager = 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
  , WebDriver -> String
wdDownloadDir :: FilePath
  }

data InvalidLogsException = InvalidLogsException [W.LogEntry]
  deriving (Int -> InvalidLogsException -> ShowS
[InvalidLogsException] -> ShowS
InvalidLogsException -> String
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}))}) = forall a. a -> Maybe a
Just Int
xvfbDisplayNum
getDisplayNumber WebDriver
_ = 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)}) = forall a. a -> Maybe a
Just XvfbSession
sess
getXvfbSession WebDriver
_ = 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 {
  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
  }