@@ -1,7 +1,7 @@
11{-# LANGUAGE OverloadedStrings #-}
22{-# LANGUAGE ScopedTypeVariables #-}
33
4−module RunSpec (main, spec, withApp, MySocket, msWrite, msRead, withMySocket) where
4+module RunSpec (main, spec, withApp, connectTo, MySocket, msWrite, msRead, msClose) where
55
66import Control.Concurrent (forkIO, killThread, threadDelay)
77import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar)
@@ -78,9 +78,6 @@ connectTo port = do
7878 , msBuffer = ref
7979 }
8080
81−withMySocket :: (MySocket -> IO a) -> Int -> IO a
82−withMySocket body port = bracket (connectTo port) msClose body
83−
8481incr :: MonadIO m => Counter -> m ()
8582incr icount = liftIO $ I.atomicModifyIORef icount $ \ecount ->
8683 ((case ecount of
@@ -157,7 +154,8 @@ runTest :: Int -- ^ expected number of requests
157154 -> IO ()
158155runTest expected app chunks = do
159156 ref <- I.newIORef (Right 0)
160− withApp defaultSettings (app ref) $ withMySocket $ \ms -> do
157+ withApp defaultSettings (app ref) $ \port -> do
158+ ms <- connectTo port
161159 forM_ chunks $ \chunk -> msWrite ms chunk
162160 _ <- timeout 100000 $ replicateM_ expected $ msRead ms 4096
163161 res <- I.readIORef ref
@@ -174,9 +172,10 @@ runTerminateTest :: InvalidRequest
174172runTerminateTest expected input = do
175173 ref <- I.newIORef Nothing
176174 let onExc _ = I.writeIORef ref . Just
177− withApp (setOnException onExc defaultSettings) dummyApp $ withMySocket $ \ms -> do
175+ withApp (setOnException onExc defaultSettings) dummyApp $ \port -> do
176+ ms <- connectTo port
178177 msWrite ms input
179− msClose ms -- explicitly
178+ msClose ms
180179 threadDelay 1000
181180 res <- I.readIORef ref
182181 show res `shouldBe` show (Just expected)
@@ -247,11 +246,13 @@ spec = do
247246 let app req f = do
248247 liftIO $ I.writeIORef iheaders $ requestHeaders req
249248 f $ responseLBS status200 [] ""
250− withApp defaultSettings app $ withMySocket $ \ms -> do
249+ withApp defaultSettings app $ \port -> do
250+ ms <- connectTo port
251251 let input = S.concat
252252 [ "GET / HTTP/1.1\r\nfoo: bar\r\n baz\r\n\tbin\r\n\r\n"
253253 ]
254254 msWrite ms input
255+ msClose ms
255256 threadDelay 1000
256257 headers <- I.readIORef iheaders
257258 headers `shouldBe`
@@ -262,11 +263,13 @@ spec = do
262263 let app req f = do
263264 liftIO $ I.writeIORef iheaders $ requestHeaders req
264265 f $ responseLBS status200 [] ""
265− withApp defaultSettings app $ withMySocket $ \ms -> do
266+ withApp defaultSettings app $ \port -> do
267+ ms <- connectTo port
266268 let input = S.concat
267269 [ "GET / HTTP/1.1\r\nfoo:bar\r\n\r\n"
268270 ]
269271 msWrite ms input
272+ msClose ms
270273 threadDelay 1000
271274 headers <- I.readIORef iheaders
272275 headers `shouldBe`
@@ -282,7 +285,8 @@ spec = do
282285 liftIO $ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ())
283286 atomically $ modifyTVar countVar (+ 1)
284287 f $ responseLBS status200 [] ""
285− withApp defaultSettings app $ withMySocket $ \ms -> do
288+ withApp defaultSettings app $ \port -> do
289+ ms <- connectTo port
286290 let input = S.concat
287291 [ "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"
288292 , "c\r\nHello World\n\r\n3\r\nBye\r\n0\r\n\r\n"
@@ -290,6 +294,7 @@ spec = do
290294 , "b\r\nHello World\r\n0\r\n\r\n"
291295 ]
292296 msWrite ms input
297+ msClose ms
293298 atomically $ do
294299 count <- readTVar countVar
295300 check $ count == 2
@@ -306,12 +311,14 @@ spec = do
306311 I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ())
307312 atomically $ modifyTVar countVar (+ 1)
308313 f $ responseLBS status200 [] ""
309− withApp defaultSettings app $ withMySocket $ \ms -> do
314+ withApp defaultSettings app $ \port -> do
315+ ms <- connectTo port
310316 let input = concat $ replicate 2 $
311317 ["POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"] ++
312318 (replicate 50 "5\r\n12345\r\n") ++
313319 ["0\r\n\r\n"]
314320 mapM_ (msWrite ms) input
321+ msClose ms
315322 atomically $ do
316323 count <- readTVar countVar
317324 check $ count == 2
@@ -327,7 +334,8 @@ spec = do
327334 liftIO $ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ())
328335 atomically $ modifyTVar countVar (+ 1)
329336 f $ responseLBS status200 [] ""
330− withApp defaultSettings app $ withMySocket $ \ms -> do
337+ withApp defaultSettings app $ \port -> do
338+ ms <- connectTo port
331339 let input = S.concat
332340 [ "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"
333341 , "c\r\nHello World\n\r\n3\r\nBye\r\n0\r\n"
@@ -335,6 +343,7 @@ spec = do
335343 , "b\r\nHello World\r\n0\r\n\r\n"
336344 ]
337345 mapM_ (msWrite ms) $ map S.singleton $ S.unpack input
346+ msClose ms
338347 atomically $ do
339348 count <- readTVar countVar
340349 check $ count == 2
@@ -355,10 +364,11 @@ spec = do
355364 E.throwIO (e :: E.SomeException)
356365 liftIO $ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ())
357366 f $ responseLBS status200 [] ""
358− withApp (setTimeout 1 defaultSettings) app $ withMySocket $ \ms -> do
367+ withApp (setTimeout 1 defaultSettings) app $ \port -> do
359368 let bs1 = S.replicate 2048 88
360369 bs2 = "This is short"
361370 bs = S.append bs1 bs2
371+ ms <- connectTo port
362372 msWrite ms "POST / HTTP/1.1\r\n"
363373 msWrite ms "content-length: "
364374 msWrite ms $ S8.pack $ show $ S.length bs
@@ -367,6 +377,7 @@ spec = do
367377 msWrite ms bs1
368378 threadDelay 100000
369379 msWrite ms bs2
380+ msClose ms
370381 threadDelay 5000000
371382 front <- I.readIORef ifront
372383 S.concat (front []) `shouldBe` bs
@@ -382,7 +393,8 @@ spec = do
382393 loop
383394 loop
384395 doubleBS = S.concatMap $ \w -> S.pack [w, w]
385− withApp defaultSettings app $ withMySocket $ \ms -> do
396+ withApp defaultSettings app $ \port -> do
397+ ms <- connectTo port
386398 msWrite ms "POST / HTTP/1.1\r\n\r\n12345"
387399 timeout 100000 (msRead ms 10) >>= (`shouldBe` Just "1122334455")
388400 msWrite ms "67890"
@@ -410,14 +422,15 @@ spec = do
410422 atomically $ modifyTVar countVar (+ 1)
411423 loop
412424 loop
413− withApp defaultSettings app $ withMySocket $ \ms -> do
414− msWrite ms "POST / HTTP/1.1\r\ntransfer-encoding: chunked\r\n\r\n"
425+ withApp defaultSettings app $ \port -> do
426+ (sock, _addr) <- getSocketTCP "127.0.0.1" port
427+ sendAll sock "POST / HTTP/1.1\r\ntransfer-encoding: chunked\r\n\r\n"
415428 threadDelay 10000
416− msWrite ms "5\r\nhello\r\n0\r\n\r\n"
429+ sendAll sock "5\r\nhello\r\n0\r\n\r\n"
417430 atomically $ do
418431 count <- readTVar countVar
419432 check $ count >= 1
420− bs <- safeRecv (msSocket ms) 4096 -- must not use msRead
433+ bs <- safeRecv sock 4096
421434 S.takeWhile (/= 13) bs `shouldBe` "HTTP/1.1 200 OK"
422435
423436 it "streaming response with length" $ do