{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ViewPatterns #-}
module Test.WebDriver (
WebDriverContext
, mkEmptyWebDriverContext
, teardownWebDriverContext
, startSession
, closeSession
, DriverConfig(..)
, startSession'
, closeSession'
, mkManualDriver
, defaultCaps
, defaultChromeOptions
, defaultFirefoxOptions
, Capabilities(..)
, Platform(..)
, ProxyType(..)
, module Test.WebDriver.Commands
, mkDriverRequest
, _driverManager
, WebDriver
, WebDriverBase
, Session
, module Test.WebDriver.Exceptions
) where
import Data.Aeson as A
import Test.WebDriver.Capabilities
import Test.WebDriver.Capabilities.Proxy
import Test.WebDriver.Commands
import Test.WebDriver.Exceptions
import Test.WebDriver.JSON
import Test.WebDriver.LaunchDriver
import Test.WebDriver.Types
import Data.Map as M
import Control.Monad.Catch (MonadMask)
import Control.Monad
import Control.Monad.IO.Class
import Data.String.Interpolate
import qualified Data.Text as T
import Test.WebDriver.Util.Aeson (aesonLookup)
import Control.Monad.Logger
import Network.HTTP.Client
import Network.HTTP.Types (RequestHeaders, statusCode)
import UnliftIO.Concurrent
import UnliftIO.Exception
startSession :: (WebDriverBase m, MonadMask m, MonadLogger m) => WebDriverContext -> DriverConfig -> Capabilities -> String -> m Session
startSession :: forall (m :: * -> *).
(WebDriverBase m, MonadMask m, MonadLogger m) =>
WebDriverContext
-> DriverConfig -> Capabilities -> String -> m Session
startSession WebDriverContext
wdc dc :: DriverConfig
dc@(DriverConfigSeleniumJar {}) Capabilities
caps String
sessionName = do
Driver
driver <- MVar (Maybe Driver)
-> (Maybe Driver -> m (Maybe Driver, Driver)) -> m Driver
forall (m :: * -> *) a b.
MonadUnliftIO m =>
MVar a -> (a -> m (a, b)) -> m b
modifyMVar (WebDriverContext -> MVar (Maybe Driver)
_webDriverSelenium WebDriverContext
wdc) ((Maybe Driver -> m (Maybe Driver, Driver)) -> m Driver)
-> (Maybe Driver -> m (Maybe Driver, Driver)) -> m Driver
forall a b. (a -> b) -> a -> b
$ \Maybe Driver
maybeSelenium -> do
Driver
driver <- m Driver -> (Driver -> m Driver) -> Maybe Driver -> m Driver
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (DriverConfig -> m Driver
forall (m :: * -> *).
(MonadUnliftIO m, MonadMask m, MonadLogger m) =>
DriverConfig -> m Driver
launchDriver DriverConfig
dc) Driver -> m Driver
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Driver
maybeSelenium
(Maybe Driver, Driver) -> m (Maybe Driver, Driver)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Driver -> Maybe Driver
forall a. a -> Maybe a
Just Driver
driver, Driver
driver)
WebDriverContext -> Driver -> Capabilities -> String -> m Session
forall (m :: * -> *).
(WebDriverBase m, MonadLogger m) =>
WebDriverContext -> Driver -> Capabilities -> String -> m Session
launchSessionInDriver WebDriverContext
wdc Driver
driver Capabilities
caps String
sessionName
startSession WebDriverContext
wdc dc :: DriverConfig
dc@(DriverConfigChromedriver {}) Capabilities
caps String
sessionName = do
Driver
driver <- MVar (Maybe Driver)
-> (Maybe Driver -> m (Maybe Driver, Driver)) -> m Driver
forall (m :: * -> *) a b.
MonadUnliftIO m =>
MVar a -> (a -> m (a, b)) -> m b
modifyMVar (WebDriverContext -> MVar (Maybe Driver)
_webDriverChromedriver WebDriverContext
wdc) ((Maybe Driver -> m (Maybe Driver, Driver)) -> m Driver)
-> (Maybe Driver -> m (Maybe Driver, Driver)) -> m Driver
forall a b. (a -> b) -> a -> b
$ \Maybe Driver
maybeChromedriver -> do
Driver
driver <- m Driver -> (Driver -> m Driver) -> Maybe Driver -> m Driver
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (DriverConfig -> m Driver
forall (m :: * -> *).
(MonadUnliftIO m, MonadMask m, MonadLogger m) =>
DriverConfig -> m Driver
launchDriver DriverConfig
dc) Driver -> m Driver
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Driver
maybeChromedriver
(Maybe Driver, Driver) -> m (Maybe Driver, Driver)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Driver -> Maybe Driver
forall a. a -> Maybe a
Just Driver
driver, Driver
driver)
WebDriverContext -> Driver -> Capabilities -> String -> m Session
forall (m :: * -> *).
(WebDriverBase m, MonadLogger m) =>
WebDriverContext -> Driver -> Capabilities -> String -> m Session
launchSessionInDriver WebDriverContext
wdc Driver
driver Capabilities
caps String
sessionName
startSession WebDriverContext
wdc dc :: DriverConfig
dc@(DriverConfigGeckodriver {}) Capabilities
caps String
sessionName = do
Driver
driver <- DriverConfig -> m Driver
forall (m :: * -> *).
(MonadUnliftIO m, MonadMask m, MonadLogger m) =>
DriverConfig -> m Driver
launchDriver DriverConfig
dc
m Session -> m () -> m Session
forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m a
onException (WebDriverContext -> Driver -> Capabilities -> String -> m Session
forall (m :: * -> *).
(WebDriverBase m, MonadLogger m) =>
WebDriverContext -> Driver -> Capabilities -> String -> m Session
launchSessionInDriver WebDriverContext
wdc Driver
driver Capabilities
caps String
sessionName)
(Driver -> m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLogger m) =>
Driver -> m ()
teardownDriver Driver
driver)
launchSessionInDriver :: (WebDriverBase m, MonadLogger m) => WebDriverContext -> Driver -> Capabilities -> String -> m Session
launchSessionInDriver :: forall (m :: * -> *).
(WebDriverBase m, MonadLogger m) =>
WebDriverContext -> Driver -> Capabilities -> String -> m Session
launchSessionInDriver WebDriverContext
wdc Driver
driver Capabilities
caps String
sessionName = do
Session
sess <- Driver -> Capabilities -> String -> m Session
forall (m :: * -> *).
(WebDriverBase m, MonadLogger m) =>
Driver -> Capabilities -> String -> m Session
startSession' Driver
driver Capabilities
caps String
sessionName
MVar (Map String Session)
-> (Map String Session -> m (Map String Session, Session))
-> m Session
forall (m :: * -> *) a b.
MonadUnliftIO m =>
MVar a -> (a -> m (a, b)) -> m b
modifyMVar (WebDriverContext -> MVar (Map String Session)
_webDriverSessions WebDriverContext
wdc) ((Map String Session -> m (Map String Session, Session))
-> m Session)
-> (Map String Session -> m (Map String Session, Session))
-> m Session
forall a b. (a -> b) -> a -> b
$ \Map String Session
sessionMap ->
case String -> Map String Session -> Maybe Session
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
sessionName Map String Session
sessionMap of
Just Session
_ -> SessionException -> m (Map String Session, Session)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO SessionException
SessionNameAlreadyExists
Maybe Session
Nothing -> (Map String Session, Session) -> m (Map String Session, Session)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Session -> Map String Session -> Map String Session
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
sessionName Session
sess Map String Session
sessionMap, Session
sess)
startSession' :: (WebDriverBase m, MonadLogger m) => Driver -> Capabilities -> String -> m Session
startSession' :: forall (m :: * -> *).
(WebDriverBase m, MonadLogger m) =>
Driver -> Capabilities -> String -> m Session
startSession' Driver
driver Capabilities
caps String
sessionName = do
Response ByteString
response <- Driver -> Method -> Text -> Value -> m (Response ByteString)
forall a.
(HasCallStack, ToJSON a) =>
Driver -> Method -> Text -> a -> m (Response ByteString)
forall (m :: * -> *) a.
(WebDriverBase m, HasCallStack, ToJSON a) =>
Driver -> Method -> Text -> a -> m (Response ByteString)
doCommandBase Driver
driver Method
methodPost Text
"/session" (Value -> m (Response ByteString))
-> Value -> m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Text -> Value -> Value
forall a. ToJSON a => Text -> a -> Value
single Text
"capabilities" (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Capabilities -> Value
forall a. ToJSON a => Text -> a -> Value
single Text
"alwaysMatch" Capabilities
caps
if | Status -> Int
statusCode (Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
response) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
200 -> do
case ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode (Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
response) of
Right x :: Value
x@(A.Object (Text -> Object -> Maybe Value
forall v. Text -> KeyMap v -> Maybe v
aesonLookup Text
"value" -> Just value :: Value
value@(A.Object (Text -> Object -> Maybe Value
forall v. Text -> KeyMap v -> Maybe v
aesonLookup Text
"sessionId" -> Just (A.String Text
sessId))))) -> do
Text -> m ()
forall (m :: * -> *). MonadLogger m => Text -> m ()
logInfoN [i|Got capabilities from driver: #{A.encode x}|]
let maybeWebSocketUrl :: Maybe Text
maybeWebSocketUrl = case Value
value of
A.Object (Text -> Object -> Maybe Value
forall v. Text -> KeyMap v -> Maybe v
aesonLookup Text
"capabilities" -> Just (A.Object (Text -> Object -> Maybe Value
forall v. Text -> KeyMap v -> Maybe v
aesonLookup Text
"webSocketUrl" -> Just (A.String Text
url)))) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
url
Value
_ -> Maybe Text
forall a. Maybe a
Nothing
Session -> m Session
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Session -> m Session) -> Session -> m Session
forall a b. (a -> b) -> a -> b
$ Session {
sessionDriver :: Driver
sessionDriver = Driver
driver
, sessionId :: SessionId
sessionId = Text -> SessionId
SessionId Text
sessId
, sessionName :: String
sessionName = String
sessionName
, sessionWebSocketUrl :: Maybe String
sessionWebSocketUrl = Text -> String
T.unpack (Text -> String) -> Maybe Text -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
maybeWebSocketUrl
}
Either String Value
_ -> SessionException -> m Session
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (SessionException -> m Session) -> SessionException -> m Session
forall a b. (a -> b) -> a -> b
$ Response ByteString -> SessionException
SessionCreationResponseHadNoSessionId Response ByteString
response
| Bool
otherwise -> SessionException -> m Session
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO SessionException
SessionNameAlreadyExists
closeSession :: (WebDriverBase m, MonadLogger m) => WebDriverContext -> Session -> m ()
closeSession :: forall (m :: * -> *).
(WebDriverBase m, MonadLogger m) =>
WebDriverContext -> Session -> m ()
closeSession WebDriverContext
wdc sess :: Session
sess@(Session {String
Maybe String
SessionId
Driver
sessionDriver :: Session -> Driver
sessionId :: Session -> SessionId
sessionName :: Session -> String
sessionWebSocketUrl :: Session -> Maybe String
sessionDriver :: Driver
sessionId :: SessionId
sessionName :: String
sessionWebSocketUrl :: Maybe String
..}) = do
Session -> m ()
forall (m :: * -> *).
(WebDriverBase m, MonadLogger m) =>
Session -> m ()
closeSession' Session
sess
MVar (Map String Session)
-> (Map String Session -> m (Map String Session)) -> m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
MVar a -> (a -> m a) -> m ()
modifyMVar_ (WebDriverContext -> MVar (Map String Session)
_webDriverSessions WebDriverContext
wdc) (Map String Session -> m (Map String Session)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map String Session -> m (Map String Session))
-> (Map String Session -> Map String Session)
-> Map String Session
-> m (Map String Session)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Map String Session -> Map String Session
forall k a. Ord k => k -> Map k a -> Map k a
M.delete String
sessionName)
case Driver -> DriverConfig
_driverConfig Driver
sessionDriver of
DriverConfigGeckodriver {} -> Driver -> m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLogger m) =>
Driver -> m ()
teardownDriver Driver
sessionDriver
DriverConfig
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
closeSession' :: (WebDriverBase m, MonadLogger m) => Session -> m ()
closeSession' :: forall (m :: * -> *).
(WebDriverBase m, MonadLogger m) =>
Session -> m ()
closeSession' (Session { sessionId :: Session -> SessionId
sessionId=(SessionId Text
sessId), String
Maybe String
Driver
sessionDriver :: Session -> Driver
sessionName :: Session -> String
sessionWebSocketUrl :: Session -> Maybe String
sessionDriver :: Driver
sessionName :: String
sessionWebSocketUrl :: Maybe String
.. }) = do
Response ByteString
_response <- Driver -> Method -> Text -> Value -> m (Response ByteString)
forall a.
(HasCallStack, ToJSON a) =>
Driver -> Method -> Text -> a -> m (Response ByteString)
forall (m :: * -> *) a.
(WebDriverBase m, HasCallStack, ToJSON a) =>
Driver -> Method -> Text -> a -> m (Response ByteString)
doCommandBase Driver
sessionDriver Method
methodDelete (Text
"/session/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sessId) Value
Null
() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
mkManualDriver :: MonadIO m =>
String
-> Int
-> String
-> RequestHeaders
-> m Driver
mkManualDriver :: forall (m :: * -> *).
MonadIO m =>
String -> Int -> String -> RequestHeaders -> m Driver
mkManualDriver String
hostname Int
port String
basePath RequestHeaders
requestHeaders = do
Manager
manager <- IO Manager -> m Manager
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Manager -> m Manager) -> IO Manager -> m Manager
forall a b. (a -> b) -> a -> b
$ ManagerSettings -> IO Manager
newManager ManagerSettings
defaultManagerSettings
Driver -> m Driver
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Driver -> m Driver) -> Driver -> m Driver
forall a b. (a -> b) -> a -> b
$ Driver {
_driverHostname :: String
_driverHostname = String
hostname
, _driverPort :: Int
_driverPort = Int
port
, _driverBasePath :: String
_driverBasePath = String
basePath
, _driverRequestHeaders :: RequestHeaders
_driverRequestHeaders = RequestHeaders
requestHeaders
, _driverManager :: Manager
_driverManager = Manager
manager
, _driverProcess :: Maybe ProcessHandle
_driverProcess = Maybe ProcessHandle
forall a. Maybe a
Nothing
, _driverLogAsync :: Maybe (Async ())
_driverLogAsync = Maybe (Async ())
forall a. Maybe a
Nothing
, _driverConfig :: DriverConfig
_driverConfig = String -> [String] -> String -> Maybe String -> DriverConfig
DriverConfigChromedriver String
"" [] String
"" Maybe String
forall a. Maybe a
Nothing
}
teardownWebDriverContext :: (WebDriverBase m, MonadLogger m) => WebDriverContext -> m ()
teardownWebDriverContext :: forall (m :: * -> *).
(WebDriverBase m, MonadLogger m) =>
WebDriverContext -> m ()
teardownWebDriverContext (WebDriverContext {MVar (Maybe Driver)
MVar (Map String Session)
_webDriverSelenium :: WebDriverContext -> MVar (Maybe Driver)
_webDriverChromedriver :: WebDriverContext -> MVar (Maybe Driver)
_webDriverSessions :: WebDriverContext -> MVar (Map String Session)
_webDriverSessions :: MVar (Map String Session)
_webDriverSelenium :: MVar (Maybe Driver)
_webDriverChromedriver :: MVar (Maybe Driver)
..}) = do
MVar (Map String Session)
-> (Map String Session -> m (Map String Session)) -> m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
MVar a -> (a -> m a) -> m ()
modifyMVar_ MVar (Map String Session)
_webDriverSessions ((Map String Session -> m (Map String Session)) -> m ())
-> (Map String Session -> m (Map String Session)) -> m ()
forall a b. (a -> b) -> a -> b
$ \Map String Session
sessions -> do
[Session] -> (Session -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Session
sess | (String
_, Session
sess) <- Map String Session -> [(String, Session)]
forall k a. Map k a -> [(k, a)]
M.toList Map String Session
sessions] ((Session -> m ()) -> m ()) -> (Session -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Session
sess ->
Session -> m ()
forall (m :: * -> *).
(WebDriverBase m, MonadLogger m) =>
Session -> m ()
closeSession' Session
sess
Map String Session -> m (Map String Session)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Map String Session
forall a. Monoid a => a
mempty
MVar (Maybe Driver) -> (Maybe Driver -> m (Maybe Driver)) -> m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
MVar a -> (a -> m a) -> m ()
modifyMVar_ MVar (Maybe Driver)
_webDriverSelenium ((Maybe Driver -> m (Maybe Driver)) -> m ())
-> (Maybe Driver -> m (Maybe Driver)) -> m ()
forall a b. (a -> b) -> a -> b
$ \case
Maybe Driver
Nothing -> Maybe Driver -> m (Maybe Driver)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Driver
forall a. Maybe a
Nothing
Just Driver
driver -> Driver -> m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLogger m) =>
Driver -> m ()
teardownDriver Driver
driver m () -> m (Maybe Driver) -> m (Maybe Driver)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Driver -> m (Maybe Driver)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Driver
forall a. Maybe a
Nothing
MVar (Maybe Driver) -> (Maybe Driver -> m (Maybe Driver)) -> m ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
MVar a -> (a -> m a) -> m ()
modifyMVar_ MVar (Maybe Driver)
_webDriverChromedriver ((Maybe Driver -> m (Maybe Driver)) -> m ())
-> (Maybe Driver -> m (Maybe Driver)) -> m ()
forall a b. (a -> b) -> a -> b
$ \case
Maybe Driver
Nothing -> Maybe Driver -> m (Maybe Driver)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Driver
forall a. Maybe a
Nothing
Just Driver
driver -> Driver -> m ()
forall (m :: * -> *).
(MonadUnliftIO m, MonadLogger m) =>
Driver -> m ()
teardownDriver Driver
driver m () -> m (Maybe Driver) -> m (Maybe Driver)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe Driver -> m (Maybe Driver)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Driver
forall a. Maybe a
Nothing