git.iko.soy/typeable/servant
on master help sign in
Merge pull request #1194 from rl-king/doc-test-warpserver

Testing cookbook recipe: use Warp.testWithApplication to prevent race condition

commit35cae91fdb433f4ad1a577a9a886c46030370185 authorAlp Mestanogullari <alpmestan@gmail.com> dateFri 16 Aug 2019, 20:39 (7 years ago) parent3712b20da174d9
1 file changed+11−13
doc/cookbook/testing/Testing.lhs+11−13
doc/cookbook/testing/Testing.lhs+11−13
@@ -142,33 +142,31 @@ of it and see how it responds.
142142Let's write some tests:
143143
144144```haskell
145−withUserApp :: IO () -> IO ()
145+withUserApp :: (Warp.Port -> IO ()) -> IO ()
146146withUserApp action =
147− -- we can spin up a server in another thread and kill that thread when done
148− -- in an exception-safe way
149− bracket (liftIO $ C.forkIO $ Warp.run 8888 userApp)
150− C.killThread
151− (const action)
147+ -- testWithApplication makes sure the action is executed after the server has
148+ -- started and is being properly shutdown.
149+ Warp.testWithApplication (pure userApp) action
152150
153151
154152businessLogicSpec :: Spec
155153businessLogicSpec =
156154 -- `around` will start our Server before the tests and turn it off after
157− around_ withUserApp $ do
155+ around withUserApp $ do
158156 -- create a test client function
159157 let createUser = client (Proxy :: Proxy UserApi)
160158 -- create a servant-client ClientEnv
161− baseUrl <- runIO $ parseBaseUrl "http://localhost:8888"
159+ baseUrl <- runIO $ parseBaseUrl "http://localhost"
162160 manager <- runIO $ newManager defaultManagerSettings
163− let clientEnv = mkClientEnv manager baseUrl
161+ let clientEnv port = mkClientEnv manager (baseUrl { baseUrlPort = port })
164162
165163 -- testing scenarios start here
166164 describe "POST /user" $ do
167− it "should create a user with a high enough ID" $ do
168− result <- runClientM (createUser 50001) clientEnv
165+ it "should create a user with a high enough ID" $ \port -> do
166+ result <- runClientM (createUser 50001) (clientEnv port)
169167 result `shouldBe` (Right $ User { name = "some user", user_id = 50001})
170− it "will it fail with a too-small ID?" $ do
171− result <- runClientM (createUser 4999) clientEnv
168+ it "will it fail with a too-small ID?" $ \port -> do
169+ result <- runClientM (createUser 4999) (clientEnv port)
172170 result `shouldBe` (Right $ User { name = "some user", user_id = 50001})
173171```
174172