diff --git a/cabal.project b/cabal.project index 2725470..129c774 100644 --- a/cabal.project +++ b/cabal.project @@ -1 +1 @@ -packages: reflex-dom-core, reflex-dom, reflex-dom-test-selenium +packages: chrome-test-utils, reflex-dom-core, reflex-dom, reflex-dom-test-selenium diff --git a/reflex-dom-test-selenium/reflex-dom-test-selenium.cabal b/reflex-dom-test-selenium/reflex-dom-test-selenium.cabal index 61f224d..1fbab04 100644 --- a/reflex-dom-test-selenium/reflex-dom-test-selenium.cabal +++ b/reflex-dom-test-selenium/reflex-dom-test-selenium.cabal @@ -19,22 +19,23 @@ library bytestring == 0.10.*, chrome-test-utils, exceptions, + hspec-core, + hspec-webdriver >= 1.2.1, + http-types, jsaddle >= 0.9.0.0 && < 0.10, jsaddle-warp, - http-types, network, - reflex-dom-core, process, + reflex-dom-core, silently, + text == 1.2.*, wai, warp, - text == 1.2.*, - websockets, - hspec-webdriver, - webdriver + webdriver, + websockets exposed-modules: - Reflex.Dom.Test.Screenshot + Reflex.Dom.Test.Selenium default-language: Haskell98 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans -fspecialise-aggressively diff --git a/reflex-dom-test-selenium/src/Reflex/Dom/Test/Screenshot.hs b/reflex-dom-test-selenium/src/Reflex/Dom/Test/Selenium.hs similarity index 67% rename from reflex-dom-test-selenium/src/Reflex/Dom/Test/Screenshot.hs rename to reflex-dom-test-selenium/src/Reflex/Dom/Test/Selenium.hs index 3655bb9..04f3f86 100644 --- a/reflex-dom-test-selenium/src/Reflex/Dom/Test/Screenshot.hs +++ b/reflex-dom-test-selenium/src/Reflex/Dom/Test/Selenium.hs @@ -9,16 +9,24 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -module Reflex.Dom.Test.Screenshot +-- | Utilities for testing reflex-dom widgets with Selenium. +-- +-- Any uses of the 'testWidget' functions will start a jsaddle warp server and +-- serve the given widget in an otherwise empty page. Webdriver commands can run +-- on the statically rendered page, and on the hydrated page. +module Reflex.Dom.Test.Selenium ( TestWidget , TestWidgetConfig (..) , testWidget, testWidget', testWidgetStatic, testWidgetHydrated - , testWithSelenium + , withSeleniumSpec + , embedSpec + , SeleniumSetupConfig (..) ) where import Control.Concurrent (threadDelay, newEmptyMVar, takeMVar, putMVar) -import Control.Monad (when, void) -import Control.Monad.Catch (MonadMask, handle, finally) +import Control.Exception (throwIO) +import Control.Monad (when) +import Control.Monad.Catch (MonadMask, handle) import Control.Monad.Fix (MonadFix) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Text (Text) @@ -32,50 +40,48 @@ import Reflex.Dom.Core import System.IO (stderr) import System.IO.Silently (hSilence) import System.Process (std_in, std_out, std_err, createProcess, proc, StdStream (..), terminateProcess) -import qualified Data.Text as T - -import qualified Control.Concurrent.Async as Async -import qualified Data.Text.Encoding as TE -import qualified Data.ByteString.Lazy as LBS -import qualified Network.Wai.Handler.Warp as Warp - -import Test.Hspec.WebDriver (SpecWith, WdTestSession, hspec, sessionWith, using) +import Test.Hspec.WebDriver (Spec, SpecWith, WdTestSession, sessionWith, using) import Test.Util.ChromeFlags import Test.Util.UnshareNetwork import Test.WebDriver (WD) + +import qualified Control.Concurrent.Async as Async +import qualified Data.ByteString.Lazy as LBS +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified Network.Wai.Handler.Warp as Warp +import qualified Test.Hspec.Core.Spec as Hspec import qualified Test.WebDriver as WD import qualified Test.WebDriver.Capabilities as WD deriving instance MonadMask WD -testWithSelenium - :: FilePath +data SeleniumSetupConfig = SeleniumSetupConfig + { _seleniumSetupConfig_chromiumPath :: FilePath -- ^ Path to the chromium executable - -> Bool + , _seleniumSetupConfig_headless :: Bool -- ^ True means that the browser is invoked in headless mode, False means that -- the user can see the interaction happening on the browser (useful for debugging). - -> SpecWith (WdTestSession a) - -- ^ The tests we want to write in the selenium session - -> IO () -testWithSelenium chromium isHeadless actualTests = do - handle (\(_ :: IOError) -> return ()) $ unshareNetork -- If we run into an exception with sandboxing, just don't bother - withSandboxedChromeFlags isHeadless $ \chromeFlags -> do - withSeleniumServer $ \selenium -> do - let browserPath = T.strip $ T.pack chromium - when (T.null browserPath) $ fail "No browser found" - let wdConfig = WD.defaultConfig { WD.wdPort = fromIntegral $ _selenium_portNumber selenium } - chromeCaps' = WD.getCaps $ chromeConfig browserPath chromeFlags - hspec (sessionWith wdConfig "" . using [(chromeCaps', "")] $ actualTests) `finally` _selenium_stopServer selenium - -seleniumPort, jsaddlePort :: PortNumber -seleniumPort = 8000 -jsaddlePort = 8001 - -data Selenium = Selenium - { _selenium_portNumber :: PortNumber - , _selenium_stopServer :: IO () + , _seleniumSetupConfig_seleniumPort :: PortNumber + -- ^ The port number used by selenium } +-- | Setup a selenium server and use it to run some hspec tests. +-- +-- withSeleniumSpec config $ \runSession -> hspec $ do +-- describe "tests using webdriver session" $ runSession $ do +-- webdriver tests here +withSeleniumSpec :: SeleniumSetupConfig -> ((forall multi. SpecWith (WdTestSession multi) -> Spec) -> IO a) -> IO a +withSeleniumSpec config runSpec = do + liftIO $ handle (\(_ :: IOError) -> return ()) $ unshareNetork -- If we run into an exception with sandboxing, just don't bother + withSandboxedChromeFlags (_seleniumSetupConfig_headless config) $ \chromeFlags -> do + withSeleniumServer (_seleniumSetupConfig_seleniumPort config) $ do + let browserPath = T.strip $ T.pack $ _seleniumSetupConfig_chromiumPath config + when (T.null browserPath) $ fail "No browser found" + let wdConfig = WD.defaultConfig { WD.wdPort = fromIntegral $ _seleniumSetupConfig_seleniumPort config } + chromeCaps' = WD.getCaps $ chromeConfig browserPath chromeFlags + runSpec $ sessionWith wdConfig "" . using [(chromeCaps', "chrome")] + startSeleniumServer :: PortNumber -> IO (IO ()) startSeleniumServer port = do (_,_,_,ph) <- createProcess $ (proc "selenium-server" ["-port", show port]) @@ -85,14 +91,10 @@ startSeleniumServer port = do } return $ terminateProcess ph -withSeleniumServer :: (Selenium -> IO ()) -> IO () -withSeleniumServer f = do - stopServer <- startSeleniumServer seleniumPort +withSeleniumServer :: PortNumber -> IO a -> IO a +withSeleniumServer port f = bracket (startSeleniumServer port) id $ \_ -> do threadDelay $ 1000 * 1000 * 2 -- TODO poll or wait on a a signal to block on - f $ Selenium - { _selenium_portNumber = seleniumPort - , _selenium_stopServer = stopServer - } + f chromeConfig :: Text -> [Text] -> WD.WDConfig chromeConfig fp flags = @@ -104,20 +106,25 @@ chromeConfig fp flags = -- Function to test widgets -------------------------------------------------------------------------------- +-- | The environment in which your widgets can be tested type TestWidget js t m = (DomBuilder t m, MonadHold t m, PostBuild t m , Prerender js t m, PerformEvent t m, TriggerEvent t m , MonadFix m, MonadIO (Performable m), MonadIO m) +-- | Configuration of individual tests data TestWidgetConfig = TestWidgetConfig - { testWidgetConfig_debug :: Bool + { _testWidgetConfig_debug :: Bool -- ^ If this flag is set to True, during the test we will emit debug messages - -- giving insight on our progress in the hydratation progress - , testWidgetConfig_headWidget :: (forall m js. TestWidget js (SpiderTimeline Global) m => m ()) + , _testWidgetConfig_headWidget :: (forall m js. TestWidget js (SpiderTimeline Global) m => m ()) -- ^ We can add widgets here that will be included in the head of the page -- (useful for example to include external js libraries in the tests) + , _testWidgetConfig_jsaddlePort :: PortNumber + -- ^ Port used by the jsaddle server } +-- | Test a widget by running some webdriver commands before and after +-- hydration. testWidget :: TestWidgetConfig -> WD a @@ -129,15 +136,18 @@ testWidget -> WD b testWidget cfg before after widget = testWidget' cfg before (const after) widget +-- | Test a widget by running some webdriver commands before hydration (on the +-- statically rendered page). testWidgetStatic :: TestWidgetConfig - -> WD () + -> WD a -- ^ Webdriver commands to run before the JS runs (i.e. on the statically rendered page) -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ()) -- ^ Widget we are testing (contents of body) - -> WD () -testWidgetStatic cfg before widget = testWidget' cfg (void before) (const $ pure ()) widget + -> WD a +testWidgetStatic cfg before widget = testWidget' cfg before pure widget +-- | Test a widget by running some webdriver commands after hydration. testWidgetHydrated :: TestWidgetConfig -> WD b @@ -147,6 +157,9 @@ testWidgetHydrated -> WD b testWidgetHydrated cfg after widget = testWidget' cfg (pure ()) (const after) widget +-- | Test a widget by running some webdriver commands before and after +-- hydration. Like 'testWidget', but you can use the result of the webdriver +-- commands from before hydration in the post hydration test. testWidget' :: TestWidgetConfig -> WD a @@ -156,7 +169,7 @@ testWidget' -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ()) -- ^ Widget we are testing (contents of body) -> WD b -testWidget' (TestWidgetConfig withDebugging headWidget) beforeJS afterSwitchover bodyWidget = do +testWidget' (TestWidgetConfig withDebugging headWidget jsaddlePort) beforeJS afterSwitchover bodyWidget = do let putStrLnDebug :: MonadIO m => Text -> m () putStrLnDebug m = when withDebugging $ liftIO $ putStrLn $ T.unpack m staticApp = do @@ -196,8 +209,8 @@ testWidget' (TestWidgetConfig withDebugging headWidget) beforeJS afterSwitchover putStrLnDebug "put waitJSaddle" ] -- hSilence to get rid of ConnectionClosed logs - silenceIfDebug = if withDebugging then id else hSilence [stderr] - jsaddleWarp = silenceIfDebug $ Warp.runSettings settings application + silenceIfNotDebugging = if withDebugging then id else hSilence [stderr] + jsaddleWarp = silenceIfNotDebugging $ Warp.runSettings settings application withAsync' jsaddleWarp $ do putStrLnDebug "taking waitJSaddle" liftIO $ takeMVar waitJSaddle @@ -216,39 +229,21 @@ testWidget' (TestWidgetConfig withDebugging headWidget) beforeJS afterSwitchover -- Utilities -------------------------------------------------------------------------------- +-- | Embed a different spec type by evaluating it directly. +embedSpec :: (Hspec.Example a, MonadIO m) => Hspec.Arg a -> a -> m () +embedSpec arg spec = liftIO $ do + Hspec.Result _info status <- Hspec.evaluateExample + spec + Hspec.defaultParams + (\actionWith -> actionWith arg) + (\_ -> pure ()) + case status of + Hspec.Success -> pure () + Hspec.Pending _ _ -> pure () -- should not happen + failure -> throwIO failure + withAsync' :: (MonadIO m, MonadMask m) => IO a -> m b -> m b withAsync' f g = bracket (liftIO $ Async.async f) (liftIO . Async.uninterruptibleCancel) (const g) - --------------------------------------------------------------------------------- - -{- Note: a nicer interface? - -This would have lead to a niced interface, but I don't think this solution is -expressible with the library - -data SessionData = SessionData - { sessionData_wdConfig :: WD.WDConfig - , sessionData_capabilities :: [Capabilities] - , sessionData_selenium :: Selenium - } - -testSpec = around bracketSelenium $ do - describe "createRecipe" $ _what - -bracketSelenium :: (SessionData -> IO ()) -> IO () -bracketSelenium action = do - handle (\(_ :: IOError) -> return ()) $ unshareNetork -- If we run into an exception with sandboxing, just don't bother - isHeadless <- pure True -- (== Nothing) <$> lookupEnv "NO_HEADLESS" - withSandboxedChromeFlags isHeadless $ \chromeFlags -> do - withSeleniumServer $ \selenium -> do - let browserPath = T.strip $ T.pack chromium - when (T.null browserPath) $ fail "No browser found" - withDebugging <- isNothing <$> lookupEnv "NO_DEBUG" - let - wdConfig = WD.defaultConfig { WD.wdPort = fromIntegral $ _selenium_portNumber selenium } - chromeCaps' = WD.getCaps $ chromeConfig browserPath chromeFlags - action (SessionData wdConfig [chromeCaps'] selenium) `finally` _selenium_stopServer selenium --}