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:
commit
35cae91fdb
1 changed files with 11 additions and 13 deletions
|
@ -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})
|
||||||
```
|
```
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue