Merge pull request #1194 from rl-king/doc-test-warpserver

Testing cookbook recipe: use Warp.testWithApplication to prevent race condition
This commit is contained in:
Alp Mestanogullari 2019-08-16 20:39:56 +02:00 committed by GitHub
commit 35cae91fdb
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23

View file

@ -142,33 +142,31 @@ of it and see how it responds.
Let's write some tests: Let's write some tests:
```haskell ```haskell
withUserApp :: IO () -> IO () withUserApp :: (Warp.Port -> IO ()) -> IO ()
withUserApp action = withUserApp action =
-- we can spin up a server in another thread and kill that thread when done -- testWithApplication makes sure the action is executed after the server has
-- in an exception-safe way -- started and is being properly shutdown.
bracket (liftIO $ C.forkIO $ Warp.run 8888 userApp) Warp.testWithApplication (pure userApp) action
C.killThread
(const action)
businessLogicSpec :: Spec businessLogicSpec :: Spec
businessLogicSpec = businessLogicSpec =
-- `around` will start our Server before the tests and turn it off after -- `around` will start our Server before the tests and turn it off after
around_ withUserApp $ do around withUserApp $ do
-- create a test client function -- create a test client function
let createUser = client (Proxy :: Proxy UserApi) let createUser = client (Proxy :: Proxy UserApi)
-- create a servant-client ClientEnv -- create a servant-client ClientEnv
baseUrl <- runIO $ parseBaseUrl "http://localhost:8888" baseUrl <- runIO $ parseBaseUrl "http://localhost"
manager <- runIO $ newManager defaultManagerSettings manager <- runIO $ newManager defaultManagerSettings
let clientEnv = mkClientEnv manager baseUrl let clientEnv port = mkClientEnv manager (baseUrl { baseUrlPort = port })
-- testing scenarios start here -- testing scenarios start here
describe "POST /user" $ do describe "POST /user" $ do
it "should create a user with a high enough ID" $ do it "should create a user with a high enough ID" $ \port -> do
result <- runClientM (createUser 50001) clientEnv result <- runClientM (createUser 50001) (clientEnv port)
result `shouldBe` (Right $ User { name = "some user", user_id = 50001}) result `shouldBe` (Right $ User { name = "some user", user_id = 50001})
it "will it fail with a too-small ID?" $ do it "will it fail with a too-small ID?" $ \port -> do
result <- runClientM (createUser 4999) clientEnv result <- runClientM (createUser 4999) (clientEnv port)
result `shouldBe` (Right $ User { name = "some user", user_id = 50001}) result `shouldBe` (Right $ User { name = "some user", user_id = 50001})
``` ```