{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE Rank2Types #-}
{-# 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 Data.Text (Text)
import Network.HTTP.Client (Manager)
import System.Process
import Test.Sandwich
import Test.Sandwich.WebDriver.Internal.Binaries.Ffmpeg
import Test.Sandwich.WebDriver.Internal.Binaries.Xvfb
import qualified Test.WebDriver as W
import qualified Test.WebDriver.Session as W
import UnliftIO.Async


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

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

webdriverSession :: Label "webdriverSession" WebDriverSession
webdriverSession :: Label "webdriverSession" WebDriverSession
webdriverSession = Label "webdriverSession" WebDriverSession
forall {k} (l :: Symbol) (a :: k). Label l a
Label

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
$cshowsPrec :: Int -> WhenToSave -> ShowS
showsPrec :: Int -> WhenToSave -> ShowS
$cshow :: WhenToSave -> String
show :: WhenToSave -> String
$cshowList :: [WhenToSave] -> ShowS
showList :: [WhenToSave] -> ShowS
Show, WhenToSave -> WhenToSave -> Bool
(WhenToSave -> WhenToSave -> Bool)
-> (WhenToSave -> WhenToSave -> Bool) -> Eq WhenToSave
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WhenToSave -> WhenToSave -> Bool
== :: WhenToSave -> WhenToSave -> Bool
$c/= :: WhenToSave -> WhenToSave -> Bool
/= :: 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.
  -- The @Xvfb@ binary must be installed and on the PATH.

data WdOptions = WdOptions {
  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 -> 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 certain binaries "on demand". These may or not be needed based on 'WdOptions', so
-- they will be obtained as needed.
data OnDemandOptions = OnDemandOptions {
  -- | How to obtain ffmpeg binary.
  OnDemandOptions -> FfmpegToUse
ffmpegToUse :: FfmpegToUse

  -- | How to obtain Xvfb binary.
  , OnDemandOptions -> XvfbToUse
xvfbToUse :: XvfbToUse
  }
defaultOnDemandOptions :: OnDemandOptions
defaultOnDemandOptions = OnDemandOptions {
  ffmpegToUse :: FfmpegToUse
ffmpegToUse = FfmpegToUse
UseFfmpegFromPath
  , xvfbToUse :: XvfbToUse
xvfbToUse = XvfbToUse
UseXvfbFromPath
  }

-- | Configuration for a headless browser.
data HeadlessConfig = HeadlessConfig {
  HeadlessConfig -> Maybe (Int, Int)
headlessResolution :: Maybe (Int, Int)
  -- ^ Resolution for the headless browser, specified as @(width, height)@. Defaults to @(1920, 1080)@.
  }

-- | Default headless config.
defaultHeadlessConfig :: HeadlessConfig
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 :: 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 :: WdOptions
defaultWdOptions :: WdOptions
defaultWdOptions = WdOptions {
  capabilities :: Capabilities
capabilities = Capabilities
forall a. Default a => a
def
  , saveSeleniumMessageHistory :: WhenToSave
saveSeleniumMessageHistory = WhenToSave
OnException
  , runMode :: RunMode
runMode = RunMode
Normal
  , httpManager :: Maybe Manager
httpManager = Maybe Manager
forall a. Maybe a
Nothing
  , httpRetryCount :: Int
httpRetryCount = Int
0
  }

data OnDemand a =
  OnDemandNotStarted
  | OnDemandInProgress (Async a)
  | OnDemandReady a
  | OnDemandErrored Text

data WebDriver = WebDriver {
  WebDriver -> String
wdName :: String
  , WebDriver -> (ProcessHandle, Maybe XvfbSession)
wdWebDriver :: (ProcessHandle, 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

  , WebDriver -> FfmpegToUse
wdFfmpegToUse :: FfmpegToUse
  , WebDriver -> MVar (OnDemand String)
wdFfmpeg :: MVar (OnDemand FilePath)

  , WebDriver -> XvfbToUse
wdXvfbToUse :: XvfbToUse
  , WebDriver -> MVar (OnDemand String)
wdXvfb :: MVar (OnDemand FilePath)
  }

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
$cshowsPrec :: Int -> InvalidLogsException -> ShowS
showsPrec :: Int -> InvalidLogsException -> ShowS
$cshow :: InvalidLogsException -> String
show :: InvalidLogsException -> String
$cshowList :: [InvalidLogsException] -> ShowS
showList :: [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 -> (ProcessHandle, Maybe XvfbSession)
wdWebDriver=(ProcessHandle
_, Just (XvfbSession {Int
xvfbDisplayNum :: XvfbSession -> Int
xvfbDisplayNum :: 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 -> (ProcessHandle, Maybe XvfbSession)
wdWebDriver=(ProcessHandle
_, 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 configured download directory for the 'WebDriver'.
getDownloadDirectory :: WebDriver -> FilePath
getDownloadDirectory :: WebDriver -> String
getDownloadDirectory = WebDriver -> String
wdDownloadDir

-- | Get the name of the 'WebDriver'.
-- This corresponds to the folder that will be created to hold the log files for the 'WebDriver'.
getWebDriverName :: WebDriver -> String
getWebDriverName :: WebDriver -> String
getWebDriverName (WebDriver {String
wdName :: WebDriver -> String
wdName :: String
wdName}) = String
wdName

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