@@ -45,7 +45,7 @@ err :: (MonadIO m, Show a) => Counter -> a -> m ()
4545err icount msg = liftIO $ I.writeIORef icount $ Left $ show msg
4646
4747readBody :: CounterApplication
48−readBody icount req = do
48+readBody icount req f = do
4949 body <- consumeBody $ requestBody req
5050 case () of
5151 ()
@@ -56,21 +56,21 @@ readBody icount req = do
5656 | not $ requestMethod req `elem` ["GET", "POST"]
5757 -> err icount ("Invalid request method (readBody)" :: String, requestMethod req)
5858 | otherwise -> incr icount
59− return $ responseLBS status200 [] "Read the body"
59+ f $ responseLBS status200 [] "Read the body"
6060
6161ignoreBody :: CounterApplication
62−ignoreBody icount req = do
62+ignoreBody icount req f = do
6363 if (requestMethod req `elem` ["GET", "POST"])
6464 then incr icount
6565 else err icount ("Invalid request method" :: String, requestMethod req)
66− return $ responseLBS status200 [] "Ignored the body"
66+ f $ responseLBS status200 [] "Ignored the body"
6767
6868doubleConnect :: CounterApplication
69−doubleConnect icount req = do
69+doubleConnect icount req f = do
7070 _ <- consumeBody $ requestBody req
7171 _ <- consumeBody $ requestBody req
7272 incr icount
73− return $ responseLBS status200 [] "double connect"
73+ f $ responseLBS status200 [] "double connect"
7474
7575nextPort :: I.IORef Int
7676nextPort = unsafePerformIO $ I.newIORef 5000
@@ -113,7 +113,7 @@ runTest expected app chunks = do
113113 Right i -> i `shouldBe` expected
114114
115115dummyApp :: Application
116−dummyApp _ = return $ responseLBS status200 [] "foo"
116+dummyApp _ f = f $ responseLBS status200 [] "foo"
117117
118118runTerminateTest :: InvalidRequest
119119 -> ByteString
@@ -193,9 +193,9 @@ spec = do
193193 describe "special input" $ do
194194 it "multiline headers" $ do
195195 iheaders <- I.newIORef []
196− let app req = do
196+ let app req f = do
197197 liftIO $ I.writeIORef iheaders $ requestHeaders req
198− return $ responseLBS status200 [] ""
198+ f $ responseLBS status200 [] ""
199199 withApp defaultSettings app $ \port -> do
200200 handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port
201201 let input = S.concat
@@ -211,9 +211,9 @@ spec = do
211211 ]
212212 it "no space between colon and value" $ do
213213 iheaders <- I.newIORef []
214− let app req = do
214+ let app req f = do
215215 liftIO $ I.writeIORef iheaders $ requestHeaders req
216− return $ responseLBS status200 [] ""
216+ f $ responseLBS status200 [] ""
217217 withApp defaultSettings app $ \port -> do
218218 handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port
219219 let input = S.concat
@@ -231,10 +231,10 @@ spec = do
231231 describe "chunked bodies" $ do
232232 it "works" $ do
233233 ifront <- I.newIORef id
234− let app req = do
234+ let app req f = do
235235 bss <- consumeBody $ requestBody req
236236 liftIO $ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ())
237− return $ responseLBS status200 [] ""
237+ f $ responseLBS status200 [] ""
238238 withApp defaultSettings app $ \port -> do
239239 handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port
240240 let input = S.concat
@@ -254,10 +254,10 @@ spec = do
254254 ]
255255 it "lots of chunks" $ do
256256 ifront <- I.newIORef id
257− let app req = do
257+ let app req f = do
258258 bss <- consumeBody $ requestBody req
259259 I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ())
260− return $ responseLBS status200 [] ""
260+ f $ responseLBS status200 [] ""
261261 withApp defaultSettings app $ \port -> do
262262 handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port
263263 let input = concat $ replicate 2 $
@@ -271,10 +271,10 @@ spec = do
271271 front [] `shouldBe` replicate 2 (S.concat $ replicate 50 "12345")
272272 it "in chunks" $ do
273273 ifront <- I.newIORef id
274− let app req = do
274+ let app req f = do
275275 bss <- consumeBody $ requestBody req
276276 liftIO $ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ())
277− return $ responseLBS status200 [] ""
277+ f $ responseLBS status200 [] ""
278278 withApp defaultSettings app $ \port -> do
279279 handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port
280280 let input = S.concat
@@ -293,7 +293,7 @@ spec = do
293293 ]
294294 it "timeout in request body" $ do
295295 ifront <- I.newIORef id
296− let app req = do
296+ let app req f = do
297297 bss <- (consumeBody $ requestBody req) `onException`
298298 liftIO (I.atomicModifyIORef ifront (\front -> (front . ("consume interrupted":), ())))
299299 liftIO $ threadDelay 4000000 `E.catch` \e -> do
@@ -302,7 +302,7 @@ spec = do
302302 , ()))
303303 E.throwIO (e :: E.SomeException)
304304 liftIO $ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ())
305− return $ responseLBS status200 [] ""
305+ f $ responseLBS status200 [] ""
306306 withApp (setTimeout 1 defaultSettings) app $ \port -> do
307307 let bs1 = S.replicate 2048 88
308308 bs2 = "This is short"
@@ -322,9 +322,9 @@ spec = do
322322 S.concat (front []) `shouldBe` bs
323323 describe "raw body" $ do
324324 it "works" $ do
325− let app _req = do
325+ let app _req f = do
326326 let backup = responseLBS status200 [] "Not raw"
327− return $ flip responseRaw backup $ \src sink -> do
327+ f $ flip responseRaw backup $ \src sink -> do
328328 let loop = do
329329 bs <- src
330330 unless (S.null bs) $ do
@@ -342,7 +342,7 @@ spec = do
342342 timeout 100000 (S.hGet handle 10) >>= (`shouldBe` Just "6677889900")
343343
344344 it "only one date and server header" $ do
345− let app _ = return $ responseLBS status200
345+ let app _ f = f $ responseLBS status200
346346 [ ("server", "server")
347347 , ("date", "date")
348348 ] ""
@@ -354,7 +354,7 @@ spec = do
354354 `shouldBe` ["date"]
355355
356356 it "streaming echo #249" $ do
357− let app req = return $ responseStream status200 [] $ \write -> do
357+ let app req f = f $ responseStream status200 [] $ \write -> do
358358 let loop = do
359359 bs <- requestBody req
360360 unless (S.null bs) $ do