{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleContexts #-}
module Test.WebDriver.Config(
    -- * WebDriver configuration
      WDConfig(..), defaultConfig
    -- * Capabilities helpers
    , modifyCaps, useBrowser, useVersion, usePlatform, useProxy
    -- * SessionHistoryConfig options
    , SessionHistoryConfig, noHistory, unlimitedHistory, onlyMostRecentHistory
    -- * Overloadable configuration
    , WebDriverConfig(..)
    ) where
import Test.WebDriver.Capabilities
import Test.WebDriver.Session

import Data.Default.Class (Default(..))
import Data.String (fromString)

import Control.Monad.Base

import Network.HTTP.Client (Manager, newManager, defaultManagerSettings)
import Network.HTTP.Types (RequestHeaders)

-- |WebDriver session configuration
data WDConfig = WDConfig {
     -- |Host name of the WebDriver server for this
     -- session (default 127.0.0.1)
      WDConfig -> String
wdHost :: String
     -- |Port number of the server (default 4444)
    , WDConfig -> Int
wdPort :: Int
     -- |Capabilities to use for this session
    , WDConfig -> Capabilities
wdCapabilities :: Capabilities
     -- |Base path for all API requests (default "\/wd\/hub")
    , WDConfig -> String
wdBasePath :: String
    -- |Custom request headers to add to every HTTP request.
    , WDConfig -> RequestHeaders
wdRequestHeaders :: RequestHeaders
    -- |Custom request headers to add *only* to session creation requests. This is usually done
    --  when a WebDriver server requires HTTP auth.
    , WDConfig -> RequestHeaders
wdAuthHeaders :: RequestHeaders
     -- |Specifies behavior of HTTP request/response history. By default we use 'unlimitedHistory'.
    , WDConfig -> SessionHistoryConfig
wdHistoryConfig :: SessionHistoryConfig
     -- |Use the given http-client 'Manager' instead of automatically creating one.
    , WDConfig -> Maybe Manager
wdHTTPManager :: Maybe Manager
     -- |Number of times to retry a HTTP request if it times out (default 0)
    , WDConfig -> Int
wdHTTPRetryCount :: Int
}

instance GetCapabilities WDConfig where
  getCaps :: WDConfig -> Capabilities
getCaps = WDConfig -> Capabilities
wdCapabilities

instance SetCapabilities WDConfig where
  setCaps :: Capabilities -> WDConfig -> WDConfig
setCaps Capabilities
caps WDConfig
conf = WDConfig
conf { wdCapabilities :: Capabilities
wdCapabilities = Capabilities
caps }

instance Default WDConfig where
    def :: WDConfig
def = WDConfig {
      wdHost :: String
wdHost              = String
"127.0.0.1"
    , wdPort :: Int
wdPort              = Int
4444
    , wdRequestHeaders :: RequestHeaders
wdRequestHeaders    = []
    , wdAuthHeaders :: RequestHeaders
wdAuthHeaders       = []
    , wdCapabilities :: Capabilities
wdCapabilities      = forall a. Default a => a
def
    , wdHistoryConfig :: SessionHistoryConfig
wdHistoryConfig     = SessionHistoryConfig
unlimitedHistory
    , wdBasePath :: String
wdBasePath          = String
"/wd/hub"
    , wdHTTPManager :: Maybe Manager
wdHTTPManager       = forall a. Maybe a
Nothing
    , wdHTTPRetryCount :: Int
wdHTTPRetryCount    = Int
0
    }

{- |A default session config connects to localhost on port 4444, and hasn't been
initialized server-side. This value is the same as 'def' but with a less
polymorphic type. -}
defaultConfig :: WDConfig
defaultConfig :: WDConfig
defaultConfig = forall a. Default a => a
def

-- |Class of types that can configure a WebDriver session.
class WebDriverConfig c where
    -- |Produces a 'Capabilities' from the given configuration.
    mkCaps :: MonadBase IO m => c -> m Capabilities

    -- |Produces a 'WDSession' from the given configuration.
    mkSession :: MonadBase IO m => c -> m WDSession

instance WebDriverConfig WDConfig where
    mkCaps :: forall (m :: * -> *). MonadBase IO m => WDConfig -> m Capabilities
mkCaps = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. GetCapabilities t => t -> Capabilities
getCaps

    mkSession :: forall (m :: * -> *). MonadBase IO m => WDConfig -> m WDSession
mkSession WDConfig{Int
String
RequestHeaders
Maybe Manager
Capabilities
SessionHistoryConfig
wdHTTPRetryCount :: Int
wdHTTPManager :: Maybe Manager
wdHistoryConfig :: SessionHistoryConfig
wdAuthHeaders :: RequestHeaders
wdRequestHeaders :: RequestHeaders
wdBasePath :: String
wdCapabilities :: Capabilities
wdPort :: Int
wdHost :: String
wdHTTPRetryCount :: WDConfig -> Int
wdHTTPManager :: WDConfig -> Maybe Manager
wdHistoryConfig :: WDConfig -> SessionHistoryConfig
wdAuthHeaders :: WDConfig -> RequestHeaders
wdRequestHeaders :: WDConfig -> RequestHeaders
wdBasePath :: WDConfig -> String
wdCapabilities :: WDConfig -> Capabilities
wdPort :: WDConfig -> Int
wdHost :: WDConfig -> String
..} = do
      Manager
manager <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe m Manager
createManager forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Manager
wdHTTPManager
      forall (m :: * -> *) a. Monad m => a -> m a
return WDSession { wdSessHost :: ByteString
wdSessHost = forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
wdHost
                       , wdSessPort :: Int
wdSessPort = Int
wdPort
                       , wdSessRequestHeaders :: RequestHeaders
wdSessRequestHeaders = RequestHeaders
wdRequestHeaders
                       , wdSessAuthHeaders :: RequestHeaders
wdSessAuthHeaders = RequestHeaders
wdAuthHeaders
                       , wdSessBasePath :: ByteString
wdSessBasePath = forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
wdBasePath
                       , wdSessId :: Maybe SessionId
wdSessId = forall a. Maybe a
Nothing
                       , wdSessHist :: [SessionHistory]
wdSessHist = []
                       , wdSessHistUpdate :: SessionHistoryConfig
wdSessHistUpdate = SessionHistoryConfig
wdHistoryConfig
                       , wdSessHTTPManager :: Manager
wdSessHTTPManager = Manager
manager
                       , wdSessHTTPRetryCount :: Int
wdSessHTTPRetryCount = Int
wdHTTPRetryCount }
      where
        createManager :: m Manager
createManager = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall a b. (a -> b) -> a -> b
$ ManagerSettings -> IO Manager
newManager ManagerSettings
defaultManagerSettings