Doing a parallel load test
begriffs opened this issue · comments
A user discovered a problem in my web server that causes it to freeze under certain types of concurrent traffic. I'm trying to model the situation in a test but having trouble with the types.
import Control.Concurrent.Async (mapConcurrently)
-- ...
context "in parallel, contentiously" $ do
it "does not crash the server" $ do
liftIO $ mapConcurrently (
const . void $ get "/foo"
) [1..100]
get "/bar" `shouldRespondWith` 200
My problem is that once I'm inside of the concurrent map I'm in IO and I don't know how to get back into WaiSession in order to make a get request. Is it possible to do this?
You will need to run your monad stack. Here is one for Yesod's test monad.
-- | Lifted version of 'mapConcurrently'. The state from
-- of all inner computations are discarded.
mapConcurrentlyTest :: Traversable t => (a -> YesodExample site b) -> t a -> YesodExample site (t b)
mapConcurrentlyTest f xs =
StateT $ \s -> (, s) <$> mapConcurrently (\x -> evalStateT (f x) s) xs
@begriffs sorry for replying late. By default hspec-wai
tests WAI applications in-memory, without opening any TCP ports. For your situation you may want to test your application through a real HTTP server (say warp
). I have some wip code (see #31) that allows this. With this I think you can do what you want:
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where
import Test.Hspec
import Test.Hspec.Wai
import Test.Hspec.Wai.Http (withServer)
import Test.Hspec.Wai.Internal
import Control.Monad.Trans.Reader
import Control.Concurrent.Async
import Network.Wai (Application)
import qualified Web.Scotty as S
main :: IO ()
main = hspec spec
app :: IO Application
app = S.scottyApp $ do
S.get "/foo" $ do
S.text "hello"
spec :: Spec
spec = withServer app $ do
describe "GET /" $ do
it "can handle concurrent requests" $ do
req <- WaiSession ask
xs <- liftIO $ do
mapConcurrently (const $ req "GET" "/foo" [] "") [1..100]
mapM_ ((`shouldRespondWith` "hello") . return) xs
I don't have many free cycles I can spent on #31, help would be much welcome.
@jwiegley found another way to do this:
instance MonadBaseControl IO WaiSession where
type StM WaiSession a = StM Session a
liftBaseWith f = WaiSession $
liftBaseWith $ \runInBase ->
f $ \k -> runInBase (unWaiSession k)
restoreM = WaiSession . restoreM
{-# INLINE liftBaseWith #-}
{-# INLINE restoreM #-}
instance MonadBase IO WaiSession where
liftBase = liftIO
This allows me to make a test like this
concurrently :: Int -> WaiExpectation -> WaiExpectation
concurrently times = liftBaseDiscard go
where
go test = void $ mapConcurrently (const test) [1..times]
spec :: SpecWith Application
spec =
describe "Queryiny in parallel" $
it "gets lots of foo" $
concurrently 10 $
get "/foo" `shouldRespondWith` 200
Right now the MonadBaseControl
and MonadBase
instances are orphans in my code, could you add them to hspec-wai?