{-# LANGUAGE CPP #-} -------------------------------------------------------------------- -- | -- Module : Test.Selenium.Server -- Copyright : (c) Galois, Inc. 2007 -- License : BSD3 -- -- Maintainer: Aaron Tomb -- Stability : provisional -- Portability: Uses mtl, Generalised Newtype Deriving, CPP -- -- A Haskell binding the HTTP protocol spoken by the Selenium Remote Control -- server. The Selenium server allows remote clients to control a web browser, -- acting as automated users. -- -------------------------------------------------------------------- module Test.Selenium.Server ( -- * Types Browser(..), SCommand(..), SeleniumRCSession(..), Selenium, -- * Basic functions mkSeleniumRCSession, startSelenium, stopSelenium, withSelenium, runSelenium, runSeleniumReader, doCommand, doCommandList, mkURI, -- * Selenium command wrappers open, click, clickAndWait, check, uncheck, typeText, isTextPresent, isElementPresent, isChecked, waitForPage, waitForCondition, keyPress, submit, selectFrame, mouseDown, mouseMove, mouseUp, dragAndDrop, dragAndDropToObject, getAttribute, getBodyText, getAllLinks, evalJS, getSelectedIndex ) where {- TODO: * more convenience functions for creating parameters -} import Control.Monad.Error import Control.Monad.Reader import Data.Maybe import Network.Browser import Network.BSD import Network.HTTP import Network.URI import Test.Selenium.Pretty import Test.Selenium.Syntax -- -- A data type representing a Selenium RC session -- data SeleniumRCSession = SeleniumRCSession { -- | The 'HostName' of the Selenium server to connect to selHost :: HostName, -- | The port of the Selenium server to connect to selPort :: Int, -- | The type of browser to start and use to run the tests selBrowser :: Browser, -- | The base URL of the site to be tested selURL :: URI, -- | A session ID filled in by 'startSelenium' selSessionID :: Maybe String, -- | Use Network.Browser instead of Network.HTTP if true selUseBrowse :: Bool } deriving (Show) -- | Browser types data Browser = InternetExplorer | Firefox | Konqueror | Opera | Safari | Chrome | Other String instance Show Browser where show InternetExplorer = "*iexplore" show Firefox = "*firefox" show Konqueror = "*konqueror" show Opera = "*opera" show Safari = "*safari" show Chrome = "*googlechrome" show (Other s) = s ------------------------------------------------------------------------ -- | The Selenium Monad, an error-handling read-only state newtype Selenium a = Selenium (ReaderT SeleniumRCSession (ErrorT String IO) a) #ifndef __HADDOCK__ deriving (Functor, Monad, MonadIO, MonadReader SeleniumRCSession , MonadError String) #endif -- | Run a Selenium action within the ErrorT monad. Useful for chaining -- together several actions without writing intermediate error handling. runSeleniumReader :: SeleniumRCSession -> Selenium a -> ErrorT String IO a runSeleniumReader sel (Selenium body) = runReaderT body sel -- | Run a Selenium action inside IO. This is the top-level function -- you'll usually use to run a Selenium command when not using -- 'withSelenium'. runSelenium :: SeleniumRCSession -> Selenium a -> IO (Either String a) runSelenium sel (Selenium body) = runErrorT $ runReaderT body sel -- | Create an unconnected Selenium session. mkSeleniumRCSession :: HostName -> Browser -> URI -> SeleniumRCSession mkSeleniumRCSession seleniumHostName browserType url = SeleniumRCSession { selHost = seleniumHostName , selPort = 4444 , selBrowser = browserType , selURL = url , selSessionID = Nothing , selUseBrowse = False} -- | Start a session, execute some code with the resulting handle, and then -- stop the session. withSelenium :: SeleniumRCSession -> Selenium a -> IO (Either String a) withSelenium sel body = runErrorT $ do newSel <- runSeleniumReader sel startSelenium runSeleniumReader newSel $ do r <- body; stopSelenium; return r -- | Connect to the server, and tell it to start a web browser. startSelenium :: Selenium SeleniumRCSession startSelenium = do sel <- ask session <- doCommand SNewSession [ show (selBrowser sel) , show (selURL sel) ] return $ sel { selSessionID = Just session } -- | Tell the server that a session is finished. stopSelenium :: Selenium () stopSelenium = do _ <- doCommand STestComplete [] return () -- STestComplete might throw errors, but otherwise doesn't -- return anything useful. ------------------------------------------------------------------------ -- | Send a Selenium command to the server with a list of arguments. doCommand :: SCommand -> [String] -> Selenium String doCommand cmd args = do sel <- ask let uri = mkURI sel cmd args when (isNothing uri) (throwError "created bad URI") -- The next line uses fromJust, but it's guaranteed to succeed, -- because of the check above. let req = Request { rqURI = fromJust uri , rqMethod = GET , rqHeaders = [] , rqBody = "" } result <- if selUseBrowse sel then liftIO $ browse $ get req else liftIO $ simpleHTTP req let textResult = either (\_ -> "ERROR: HTTP Request failed") (\r -> rspBody r) result when (take 5 textResult == "ERROR") (throwError textResult) return $ stringResult textResult where get req = do setErrHandler error -- XXX: this is awful setOutHandler (const $ return ()) rsp <- request req return (Right $ snd rsp) -- | Execute a list of Selenium commands paired with arguments, and return -- | a list of results. doCommandList :: [(SCommand, [String])] -> Selenium [String] doCommandList = mapM (uncurry doCommand) ------------------------------------------------------------------------ mkURI :: SeleniumRCSession -> SCommand -> [String] -> Maybe URI mkURI sel cmd args = parseURI $ "http://" ++ selHost sel <:> show (selPort sel) ++ "/selenium-server/driver/?cmd" <=> rest where rest = escape (show cmd) ++ concatMap toField (zip indices (map escape args)) ++ sessionId indices = iterate (+1) (1::Integer) toField (key, val) = "&" ++ show key <=> val sessionId = maybe "" (\p -> "&sessionId" <=> p) (selSessionID sel) escape s = escapeURIString isUnreserved s stringResult :: String -> String stringResult s = case s of 'O':'K':',':ts -> ts 'F':'A':'I':'L':',':ts -> ts ts -> ts integerResult :: String -> Integer integerResult = read . stringResult boolResult :: String -> Bool boolResult str = stringResult str == "true" -- TODO: Should this use parsec (or a CSV parser)? stringListResult :: String -> [String] stringListResult str = reverse $ parseCSVLine [] "" str where parseCSVLine :: [String] -> String -> String -> [String] parseCSVLine fields field [] = (reverse field):fields parseCSVLine fields field ('\\':c:rest) = parseCSVLine fields (c:field) rest parseCSVLine fields field (',':rest) = parseCSVLine ((reverse field):fields) "" rest parseCSVLine fields field (c:rest) = parseCSVLine fields (c:field) rest ------------------------------------------------------------------------ liftCommand :: (String -> a) -> SCommand -> [String] -> Selenium a liftCommand f cmd args = (liftM f) $ doCommand cmd args integerCommand :: SCommand -> [String] -> Selenium Integer integerCommand = liftCommand integerResult boolCommand :: SCommand -> [String] -> Selenium Bool boolCommand = liftCommand boolResult stringListCommand :: SCommand -> [String] -> Selenium [String] stringListCommand = liftCommand stringListResult ------------------------------------------------------------------------ -- -- Selenium syntax lifted into a command -- More of these would be useful. I've just added them as needed. -- -- The external API people actually write tests for: -- open :: String -> Selenium String open url = doCommand SOpen [url] submit :: Locator -> Selenium String submit locator = doCommand SSubmit [show locator] selectFrame :: String -> Selenium String selectFrame name = doCommand SSelectFrame [name] check, uncheck, click :: Locator -> Selenium String check locator = doCommand SCheck [show locator] uncheck locator = doCommand SUncheck [show locator] click locator = doCommand SClick [show locator] clickAndWait :: Locator -> Selenium String clickAndWait locator = do _ <- click locator; waitForPage 30000 isTextPresent :: String -> Selenium Bool isTextPresent txt = boolCommand SIsTextPresent [txt] isElementPresent :: Locator -> Selenium Bool isElementPresent locator = boolCommand SIsElementPresent [show locator] isChecked :: Locator -> Selenium Bool isChecked locator = boolCommand SIsChecked [show locator] typeText, keyPress :: Locator -> String -> Selenium String typeText locator txt = doCommand SType [show locator, txt] keyPress locator key = doCommand SKeyPress [show locator, key] waitForPage :: Integer -> Selenium String waitForPage timeout = doCommand SWaitForPage [show timeout] mouseDown, mouseMove, mouseUp :: Locator -> Selenium String mouseDown loc = doCommand SMouseDown [show loc] mouseMove loc = doCommand SMouseMove [show loc] mouseUp loc = doCommand SMouseUp [show loc] dragAndDrop :: Locator -> String -> Selenium String dragAndDrop loc movement = doCommand SDragAndDrop [show loc, movement] dragAndDropToObject :: Locator -> Locator -> Selenium String dragAndDropToObject src dst = doCommand SDragAndDropToObject [show src , show dst] getAttribute :: Locator -> Selenium String getAttribute locator = doCommand SGetAttribute [show locator] getBodyText :: Selenium String getBodyText = doCommand SGetBodyText [] evalJS :: String -> Selenium String evalJS script = doCommand SEval [script] waitForCondition :: String -> Integer -> Selenium String waitForCondition cond timeout = doCommand SWaitForCondition [cond, show timeout] getAllLinks :: Selenium [String] getAllLinks = stringListCommand SGetAllLinks [] getSelectedIndex :: Locator -> Selenium Integer getSelectedIndex locator = integerCommand SGetSelectedIndex [show locator] -- -- ToDo: a proper evaluator for these, with arguments in the type.