git.iko.soy/typeable/servant
on master help sign in
Use Warp.testWithApplication to prevent race conditions
da174d9rl-king
doc/cookbook/testing/Testing.lhs+11−13
@@ -142,33 +142,31 @@ of it and see how it responds.
142Let's write some tests:
142Let's write some tests:
143
143
144```haskell
144```haskell
145−withUserApp :: IO () -> IO ()
145+withUserApp :: (Warp.Port -> IO ()) -> IO ()
146withUserApp action =
146withUserApp action =
147− -- we can spin up a server in another thread and kill that thread when done
147+ -- testWithApplication makes sure the action is executed after the server has
148− -- in an exception-safe way
148+ -- started and is being properly shutdown.
149− bracket (liftIO $ C.forkIO $ Warp.run 8888 userApp)
149+ Warp.testWithApplication (pure userApp) action
150− C.killThread
151− (const action)
152
150
153
151
154businessLogicSpec :: Spec
152businessLogicSpec :: Spec
155businessLogicSpec =
153businessLogicSpec =
156 -- `around` will start our Server before the tests and turn it off after
154 -- `around` will start our Server before the tests and turn it off after
157− around_ withUserApp $ do
155+ around withUserApp $ do
158 -- create a test client function
156 -- create a test client function
159 let createUser = client (Proxy :: Proxy UserApi)
157 let createUser = client (Proxy :: Proxy UserApi)
160 -- create a servant-client ClientEnv
158 -- create a servant-client ClientEnv
161− baseUrl <- runIO $ parseBaseUrl "http://localhost:8888"
159+ baseUrl <- runIO $ parseBaseUrl "http://localhost"
162 manager <- runIO $ newManager defaultManagerSettings
160 manager <- runIO $ newManager defaultManagerSettings
163− let clientEnv = mkClientEnv manager baseUrl
161+ let clientEnv port = mkClientEnv manager (baseUrl { baseUrlPort = port })
164
162
165 -- testing scenarios start here
163 -- testing scenarios start here
166 describe "POST /user" $ do
164 describe "POST /user" $ do
167− it "should create a user with a high enough ID" $ do
165+ it "should create a user with a high enough ID" $ \port -> do
168− result <- runClientM (createUser 50001) clientEnv
166+ result <- runClientM (createUser 50001) (clientEnv port)
169 result `shouldBe` (Right $ User { name = "some user", user_id = 50001})
167 result `shouldBe` (Right $ User { name = "some user", user_id = 50001})
170− it "will it fail with a too-small ID?" $ do
168+ it "will it fail with a too-small ID?" $ \port -> do
171− result <- runClientM (createUser 4999) clientEnv
169+ result <- runClientM (createUser 4999) (clientEnv port)
172 result `shouldBe` (Right $ User { name = "some user", user_id = 50001})
170 result `shouldBe` (Right $ User { name = "some user", user_id = 50001})
173```
171```
174
172