diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2013 John Lenz + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,5 @@ +This package integrates [hspec](http://hspec.github.io) with +[hs-webdriver](https://hackage.haskell.org/package/webdriver), allowing you to write webdriver tests +using hspec. This package contains no code testing the `hspec-webdriver` package itself. The +`webdriver-angular` package contains some test code which test both the Angular webdriver commands +in `webdriver-angular` and some tests of functions in `hspec-webdriver`. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Test/Hspec/WebDriver.hs b/Test/Hspec/WebDriver.hs new file mode 100644 --- /dev/null +++ b/Test/Hspec/WebDriver.hs @@ -0,0 +1,219 @@ +{-# LANGUAGE OverloadedStrings, FlexibleInstances, DeriveDataTypeable, TypeFamilies #-} +-- | Write hspec tests that are webdriver tests, automatically managing the webdriver sessions. +-- +-- This module re-exports functions from "Test.Hspec" and "Test.WebDriver.Commands" and it is +-- intended that you just import @Test.Hspec.WebDriver@. If you need to import @Test.Hspec@ or +-- @Test.WebDriver@, you should do so using a qualified import. +-- +-- >{-# LANGUAGE OverloadedStrings #-} +-- >module XKCD where +-- > +-- >import Test.Hspec.WebDriver +-- > +-- >main :: IO () +-- >main = hspec $ +-- > describe "XKCD Tests" $ do +-- > it "checks hover text of 327" $ using Firefox $ do +-- > openPage "http://www.xkcd.com/327/" +-- > e <- findElem $ ByCSS "div#comic > img" +-- > e `shouldBeTag` "img" +-- > e `shouldHaveAttr` ("title", "Her daughter is named Help I'm trapped in a driver's license factory.") +-- > +-- > parallel $ it "checks title of 303" $ using [Firefox, Chrome] $ do +-- > openPage "http://www.xkcd.com/303/" +-- > e <- findElem $ ById "ctitle" +-- > e `shouldBeTag` "div" +-- > e `shouldHaveText` "Compiling" +-- > +-- > it "checks image of 1310" pending +-- +-- The above code assumes selenium-server-standalone is running on @127.0.0.1:4444@ at path +-- @\/wd\/hub@ (this is the default). You can configure this using `createSessionManager'`. +module Test.Hspec.WebDriver( + -- * Webdriver + BrowserDefaults(..) + , it + , Using(..) + , pending + , pendingWith + , WdExpectation(..) + + -- * Expectations + , shouldBe + , shouldBeTag + , shouldHaveText + , shouldHaveAttr + , shouldReturn + , shouldThrow + + -- * Session Manager + , createSessionManager + , createSessionManager' + + -- * Custom Capabilities + , TestCapabilities(..) + + -- * Re-exports from hspec + , hspec + , Spec + , describe + , context + , parallel + -- $beforeTodo + + -- * Re-exports from "Test.WebDriver" + , WD + , liftIO + , module Test.WebDriver.Commands + + -- * Internal + , withCaps +) where + +import Control.Exception.Lifted (try, Exception) +import Control.Monad.IO.Class (liftIO) +import Data.Typeable (Typeable) +import Test.HUnit (assertEqual, assertFailure) +import Test.Hspec hiding (shouldReturn, shouldBe, shouldSatisfy, shouldThrow, it, pending, pendingWith) +import Test.Hspec.Core (Result(..), fromSpecList, SpecTree(..), Item(..), Params) +import Test.WebDriver hiding (Browser(..)) +import Test.WebDriver.Commands +import qualified Test.WebDriver as W +import qualified Test.Hspec as H +import qualified Data.Text as T + +import Test.Hspec.WebDriver.Internal + +-- | Webdriver expectations consist of a set of browser 'Capabilities' to use and the actual test as +-- a 'W.WD' monad. The browser capabilities are specified by an enumeration which is an instance of +-- 'TestCapabilities'. The @BrowserDefaults@ enumeration provides items that represent the default set of +-- capabilities for each browser. When creating new sessions, the 'defaultCaps' are used. Also, +-- any existing session (which exists at program startup) which matches the browser is used, no +-- matter the actual capabilities. +-- +-- To obtain more control over the capabilities (e.g. to test multiple versions of IE or to test +-- Firefrox without javascript), you should @import Test.Hspec.WebDriver hiding (BrowserDefaults)@ +-- and then create your own enumeration which is an instance of 'TestCapabilities' and 'Using'. +data BrowserDefaults = Firefox | Chrome | IE | Opera | IPhone | IPad | Android + deriving (Eq, Show, Enum, Bounded, Typeable) + +instance TestCapabilities BrowserDefaults where + matchesCaps Firefox (Capabilities { browser = W.Firefox _ _ _ }) = True + matchesCaps Chrome (Capabilities { browser = W.Chrome _ _ _ _ }) = True + matchesCaps IE (Capabilities { browser = W.IE _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ }) = True + matchesCaps Opera (Capabilities { browser = W.Opera _ _ _ _ _ _ _ _ _ _ _ _ }) = True + matchesCaps IPhone (Capabilities { browser = W.IPhone}) = True + matchesCaps IPad (Capabilities { browser = W.IPad }) = True + matchesCaps Android (Capabilities { browser = W.Android }) = True + matchesCaps _ _ = False + + newCaps Firefox = return $ defaultCaps { browser = firefox } + newCaps Chrome = return $ defaultCaps { browser = chrome } + newCaps IE = return $ defaultCaps { browser = ie } + newCaps Opera = return $ defaultCaps { browser = opera } + newCaps IPhone = return $ defaultCaps { browser = iPhone } + newCaps IPad = return $ defaultCaps { browser = iPad } + newCaps Android = return $ defaultCaps { browser = android } + +-- | A webdriver expectation is either an action and a list of capabilities (which should be an instance of +-- 'TestCapabilities') or a pending message. +data WdExpectation cap = WdTest [cap] (WD ()) + | WdPending (Maybe String) + +-- | Evaluate an expectation to a list of the function expected by hspec. +evaluateWd :: (Show cap, TestCapabilities cap) => WdExpectation cap -> [(String,Params -> (IO () -> IO ()) -> IO Result)] +evaluateWd (WdPending msg) = [("", \_ _ -> return $ Pending msg)] +evaluateWd (WdTest cs test) = map mkItem cs + where + mkItem c = ("using " ++ show c, eval c) + + eval :: TestCapabilities c => c -> params -> (IO () -> IO ()) -> IO Result + eval c _ action = do action (runWD defaultSession $ withCaps c test) + return Success + +-- | A typeclass of things which can be converted to a 'WdExpectation'. This is the primary method +-- to create expectations to pass to 'it'. Both a single 'BrowserDefaults' and a list +-- of 'BrowserDefaults' can be used. +-- +-- >it "opens the home page" $ using Firefox $ do +-- > ... +-- >it "opens the users page" $ using [Firefox, Chrome] $ do +-- > ... +class Using a where + type UsingCapabilities a :: * + using :: a -> WD () -> WdExpectation (UsingCapabilities a) + +instance Using BrowserDefaults where + type UsingCapabilities BrowserDefaults = BrowserDefaults + using d = WdTest [d] + +instance Using [BrowserDefaults] where + type UsingCapabilities [BrowserDefaults] = BrowserDefaults + using = WdTest + +-- | Create a spec from a webdriver expectation. +-- +-- The webdriver expectation consists of a list of browser capabilities and the actual test. The +-- test will be executed once for each set of capabilities in the list. By default, the tests will be +-- executed serially. You can use 'parallel' to execute the test on all capabilities in parallel. +-- +-- To run the test, a webdriver session is allocated from a pool of sessions (in a thread-safe +-- manner). The pools will be initialized automatically from existing sessions the first time a +-- test is run; you can explicitly create the pools using 'createSessionManager'. +it :: (Show cap, TestCapabilities cap) => String -> WdExpectation cap -> Spec +it msg a = spec + where + mkItem m f = SpecItem Item { itemIsParallelizable = False + , itemRequirement = m + , itemExample = f + } + spec = case evaluateWd a of + [] -> fromSpecList [] + [("",f)] -> fromSpecList [mkItem (msg) f] + [(m,f)] -> fromSpecList [mkItem (msg ++ " " ++ m) f] + ss -> describe msg $ fromSpecList $ map (uncurry mkItem) ss + +-- | A 'WdExpectation' that is pending. +pending :: WdExpectation () +pending = WdPending Nothing + +-- | A 'WdExpectation' that is pending, with a message. +pendingWith :: String -> WdExpectation () +pendingWith = WdPending . Just + +-- | 'H.shouldBe' lifted into the 'WD' monad. +shouldBe :: (Show a, Eq a) => a -> a -> WD () +x `shouldBe` y = liftIO $ x `H.shouldBe` y + +-- | Asserts that the given element matches the given tag. +shouldBeTag :: Element -> T.Text -> WD () +e `shouldBeTag` name = do + t <- tagName e + liftIO $ assertEqual ("tag of " ++ show e) name t + +-- | Asserts that the given element has the given text. +shouldHaveText :: Element -> T.Text -> WD () +e `shouldHaveText` txt = do + t <- getText e + liftIO $ assertEqual ("text of " ++ show e) txt t + +-- | Asserts that the given elemnt has the attribute given by @(attr name, value)@. +shouldHaveAttr :: Element -> (T.Text, T.Text) -> WD () +e `shouldHaveAttr` (a, txt) = do + t <- attr e a + liftIO $ assertEqual ("attribute " ++ T.unpack a ++ " of " ++ show e) (Just txt) t + +-- | Asserts that the action returns the expected result. +shouldReturn :: (Show a, Eq a) => WD a -> a -> WD () +action `shouldReturn` expected = action >>= (\a -> liftIO $ a `H.shouldBe` expected) + +-- | Asserts that the action throws an exception. +shouldThrow :: (Show e, Eq e, Exception e) => WD a -> e -> WD () +shouldThrow w expected = do + r <- try w + case r of + Left err -> err `shouldBe` expected + Right _ -> liftIO $ assertFailure $ "did not get expected exception " ++ show expected + +-- $beforeTodo +-- Future TODO: lift 'before', 'after', and 'around' into the 'WD' monad. diff --git a/Test/Hspec/WebDriver/Internal.hs b/Test/Hspec/WebDriver/Internal.hs new file mode 100644 --- /dev/null +++ b/Test/Hspec/WebDriver/Internal.hs @@ -0,0 +1,213 @@ +{-# LANGUAGE ExistentialQuantification #-} +module Test.Hspec.WebDriver.Internal( + TestCapabilities(..) + , createSessionManager + , createSessionManager' + , withCaps +) where + +import Control.Concurrent.STM +import Control.Exception.Lifted (finally, onException) +import Control.Monad.IO.Class (liftIO) +import Data.Hashable +import Data.List (partition) +import Data.Maybe (fromJust) +import Data.Typeable +import Data.Word (Word16) +import System.IO.Unsafe (unsafePerformIO) +import Test.WebDriver +import Test.WebDriver.Classes +import qualified Data.HashMap.Lazy as M + +-- | Provides information about the browser capabilities used for testing. If you want more control +-- over capabilities, you should hide @BrowserDefaults@ and then make +-- an enumeration of all the webdriver capabilities you will be testing with. For example, +-- +-- >data TestCaps = Firefox +-- > | FirefoxWithoutJavascript +-- > | Chrome +-- > | IE8 +-- > | IE9 +-- > deriving (Show, Eq, Bounded, Enum, Typeable) +-- +-- @TestCaps@ must then be made an instance of @TestCapabilities@. Also, instances of @Using@ +-- should be created. +class (Eq c, Enum c, Typeable c) => TestCapabilities c where + + -- | Check if the 'Capabilities' match your enumeration. Note that these capabilities + -- will be the actual capabilities (with things like version information filled in) + -- so you should not use @==@ to compare capabilities, only check the actual capabilities you + -- care about. + matchesCaps :: c -> Capabilities -> Bool + + -- | The capabilities to pass to 'createSession' when no existing session is found. + newCaps :: c -> WD Capabilities + +-- | This instance is used for pending messages, no capabilities are matched or created. +instance TestCapabilities () where + matchesCaps () _ = False + newCaps () = error "Cannot create caps for ()" + +data SomeCap = forall c. TestCapabilities c => SomeCap c + +instance Eq SomeCap where + SomeCap c1 == SomeCap c2 = case cast c2 of + Just c2' -> c1 == c2' + Nothing -> False + +instance Hashable SomeCap where + hashWithSalt i (SomeCap c) = hashUsing fromEnum i c + +data ManagedSessions = ManagedSessions + { maxSessions :: Int + -- ^ maximum number of sessions that should be created + , managedSessions :: M.HashMap SomeCap (TVar ([SessionId],Int)) + -- ^ For each cap, store the list of unused sessions and a count of in-use sessions. + , initialSessions :: [(SessionId,Capabilities)] + -- ^ sessions which existed at program start and are not yet assigned. + + -- | settings for session + , mwdHost :: String + , mwdPort :: Word16 + , mwdBasePath :: String + } + +-- | Stores the managed sessions +sessionManager :: TVar (Maybe ManagedSessions) +{-# NOINLINE sessionManager #-} +sessionManager = unsafePerformIO (newTVarIO Nothing) + +-- | Create and set the session manager +createWdMan :: Int -> Maybe (String, Word16, String) -> WD () +createWdMan maxSess mSettings = do + let (host,port,bpath) = case mSettings of + Just s -> s + Nothing -> (wdHost defaultSession, wdPort defaultSession, wdBasePath defaultSession) + sess <- sessions + + let manager = ManagedSessions maxSess M.empty sess host port bpath + + liftIO $ atomically $ do + mm <- readTVar sessionManager + case mm of + Just _ -> return () -- manager has already been created + Nothing -> writeTVar sessionManager $ Just manager + +-- | Create a new session manager using the default webdriver host (127.0.0.1), port (4444), and +-- basepath (@\/wd\/hub@). +-- +-- The session manager hands out sessions to tests (in a thread-safe manner). Threads ask for +-- sessions by an enumeration which is an instance of 'TestCapabilities', and the manager stores a +-- pool of sessions for each enumeration item. When calling 'createSessionManager', the already +-- existing sessions are loaded and used as the initial sessions in the pools. If a thread asks for +-- a session but none is available, one of two things happens: if the total number of sessions for +-- this enumeration item is larger than the argument to 'createSessionManager', the thread will +-- block until a session is available. If the total number of sessions for this enumeration item is +-- smaller, a new session will be created. This is only relevant if you run tests in parallel, +-- since when running tests serially at most one session will be in use at any one time in any case. +-- Note that sessions are never closed by the manager. +-- +-- If you do not call 'createSessionManager', when the very first test is run a new manager will be +-- created where the maximum number of sessions per enumeration item is one. +createSessionManager :: Int -- ^ threshold number of sessions per enumeration item beyond which new + -- sessions are no longer created. Note you can set this to zero so + -- that new sessions are never created; the only sessions used will be + -- those that already exist. + -> IO () +createSessionManager maxSess = runWD defaultSession $ createWdMan maxSess Nothing + +-- | Same as 'createSessionManager' but allows you to specify the webdriver host, port, and base +-- path for all sessions. +createSessionManager' :: Int -- ^ threshold number of sessions per enumeration item + -> String -- ^ host + -> Word16 -- ^ port + -> String -- ^ base path + -> IO () +createSessionManager' maxSess host port bpath = do + let sess = WDSession { wdHost = host + , wdPort = port + , wdBasePath = bpath + , wdSessId = Nothing + , lastHTTPRequest = Nothing + } + runWD sess $ createWdMan maxSess $ Just (host, port, bpath) + +-- | Create a session +createSessionId :: SomeCap -> WD SessionId +createSessionId (SomeCap c) = do + caps <- newCaps c + sess <- createSession caps + return $ fromJust $ wdSessId sess + +-- | Searches for a session. Returns the action to be used to obtain the session. +findSession :: SomeCap -> ManagedSessions -> STM (WD SessionId) +findSession sc@(SomeCap c) m = + case M.lookup sc $ managedSessions m of + Just tvar -> do + (sess,count) <- readTVar tvar + case sess of + (s:ss) -> do writeTVar tvar (ss, count + 1) + return $ return s + + [] | count >= maxSessions m -> retry -- retry blocks until a tvar changes + + | otherwise -> do writeTVar tvar ([], count + 1) + let create = createSessionId sc `onException` (liftIO $ atomically $ do + (s',cnt) <- readTVar tvar + writeTVar tvar (s', cnt - 1)) + return create + + Nothing -> do + let (sess, unmanaged') = partition (\(_,cap) -> matchesCaps c cap) $ initialSessions m + tvar <- newTVar (map fst sess, 0) + let m' = m { initialSessions = unmanaged' + , managedSessions = M.insert sc tvar $ managedSessions m + } + writeTVar sessionManager $ Just m' + findSession sc m' + +-- | Take a session out of the pool, using an existing unused session, creating a new session, or +-- blocking if the maximum number of sessions already exist. The new session is set into the 'WD' +-- monad. Note the session can leak if you do not properly call 'putSessionId'. +takeSession :: TestCapabilities s => s -> WD () +takeSession s = do + msess <- liftIO $ atomically $ do + mm <- readTVar sessionManager + case mm of + Nothing -> return Nothing + Just m -> do r <- findSession (SomeCap s) m + return $ Just (r, mwdHost m, mwdPort m, mwdBasePath m) + case msess of + Just (r, host, port, bpath) -> do + let sess = WDSession { wdHost = host + , wdPort = port + , wdBasePath = bpath + , wdSessId = Nothing + , lastHTTPRequest = Nothing + } + putSession sess + sid <- r + putSession sess { wdSessId = Just sid } + + Nothing -> do + createWdMan 1 Nothing + takeSession s + +-- | Add a session ID back into the pool. +putSessionId :: TestCapabilities s => s -> SessionId -> WD () +putSessionId s sid = liftIO $ atomically $ do + mm <- readTVar sessionManager + let m = maybe (error "Cannot put a session to an uninitialized manager") id mm + case M.lookup (SomeCap s) $ managedSessions m of + Nothing -> error "Cannot put a session to a cap that does not exist" + Just tvar -> do + (ss,cnt) <- readTVar tvar + writeTVar tvar (sid:ss,cnt-1) + +-- | Find or create a new session, set it into the 'WD' monad, run the given action, and return the +-- session back into the pool once the action completes or an exception occurs. +withCaps :: TestCapabilities s => s -> WD a -> WD a +withCaps tc test = do + takeSession tc + sess <- getSession + test `finally` putSessionId tc (fromJust $ wdSessId sess) diff --git a/hspec-webdriver.cabal b/hspec-webdriver.cabal new file mode 100644 --- /dev/null +++ b/hspec-webdriver.cabal @@ -0,0 +1,40 @@ +name: hspec-webdriver +version: 0.1.0 +cabal-version: >= 1.8 +build-type: Simple +synopsis: Write end2end web application tests using webdriver and hspec +category: Web +author: John Lenz +maintainer: John Lenz +license: MIT +license-file: LICENSE +homepage: https://bitbucket.org/wuzzeb/webdriver-utils +stability: Experimental +description: For end to end testing of web applications from Haskell, the + package is a great tool but just + contains the code to communicate with the browser. This package integrates webdriver + with . + +extra-source-files: README.md + +source-repository head + type: mercurial + location: https://bitbucket.org/wuzzeb/webdriver-utils + +library + hs-source-dirs: . + exposed-modules: Test.Hspec.WebDriver + other-modules: Test.Hspec.WebDriver.Internal + ghc-options: -Wall -O2 + + build-depends: base >= 4 && < 5 + + , HUnit >= 1.2 && < 1.3 + , hashable >= 1.2 + , hspec >= 1.8 && < 1.9 + , lifted-base >= 0.2 + , stm >= 2.4 + , text >= 0.11 + , transformers >= 0.3 + , unordered-containers >= 0.2 + , webdriver >= 0.5 && < 0.6