@@ -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)
@@ -37,7 +37,7 @@ type CounterApplication = Counter -> Application
3737
3838data MySocket = MySocket
3939 { msSocket :: !Socket
40− , msBuffer :: !(I.IORef ByteString)
40+ , _msBuffer :: !(I.IORef ByteString)
4141 }
4242
4343msWrite :: MySocket -> ByteString -> IO ()
@@ -70,16 +70,9 @@ msClose :: MySocket -> IO ()
7070msClose = Network.Socket.close . msSocket
7171
7272connectTo :: Int -> IO MySocket
73−connectTo port = do
74− s <- fst <$> getSocketTCP "127.0.0.1" port
75− ref <- I.newIORef mempty
76− return MySocket {
77− msSocket = s
78− , msBuffer = ref
79− }
80−
81−withMySocket :: (MySocket -> IO a) -> Int -> IO a
82−withMySocket body port = bracket (connectTo port) msClose body
73+connectTo port = MySocket
74+ <$> (fst <$> getSocketTCP "127.0.0.1" port)
75+ <*> I.newIORef mempty
8376
8477incr :: MonadIO m => Counter -> m ()
8578incr icount = liftIO $ I.atomicModifyIORef icount $ \ecount ->
@@ -157,7 +150,8 @@ runTest :: Int -- ^ expected number of requests
157150 -> IO ()
158151runTest expected app chunks = do
159152 ref <- I.newIORef (Right 0)
160− withApp defaultSettings (app ref) $ withMySocket $ \ms -> do
153+ withApp defaultSettings (app ref) $ \port -> do
154+ ms <- connectTo port
161155 forM_ chunks $ \chunk -> msWrite ms chunk
162156 _ <- timeout 100000 $ replicateM_ expected $ msRead ms 4096
163157 res <- I.readIORef ref
@@ -174,9 +168,10 @@ runTerminateTest :: InvalidRequest
174168runTerminateTest expected input = do
175169 ref <- I.newIORef Nothing
176170 let onExc _ = I.writeIORef ref . Just
177− withApp (setOnException onExc defaultSettings) dummyApp $ withMySocket $ \ms -> do
178− msWrite ms input
179− msClose ms -- explicitly
171+ withApp (setOnException onExc defaultSettings) dummyApp $ \port -> do
172+ handle <- connectTo port
173+ msWrite handle input
174+ msClose handle
180175 threadDelay 1000
181176 res <- I.readIORef ref
182177 show res `shouldBe` show (Just expected)
@@ -247,11 +242,13 @@ spec = do
247242 let app req f = do
248243 liftIO $ I.writeIORef iheaders $ requestHeaders req
249244 f $ responseLBS status200 [] ""
250− withApp defaultSettings app $ withMySocket $ \ms -> do
245+ withApp defaultSettings app $ \port -> do
246+ handle <- connectTo port
251247 let input = S.concat
252248 [ "GET / HTTP/1.1\r\nfoo: bar\r\n baz\r\n\tbin\r\n\r\n"
253249 ]
254− msWrite ms input
250+ msWrite handle input
251+ msClose handle
255252 threadDelay 1000
256253 headers <- I.readIORef iheaders
257254 headers `shouldBe`
@@ -262,11 +259,13 @@ spec = do
262259 let app req f = do
263260 liftIO $ I.writeIORef iheaders $ requestHeaders req
264261 f $ responseLBS status200 [] ""
265− withApp defaultSettings app $ withMySocket $ \ms -> do
262+ withApp defaultSettings app $ \port -> do
263+ handle <- connectTo port
266264 let input = S.concat
267265 [ "GET / HTTP/1.1\r\nfoo:bar\r\n\r\n"
268266 ]
269− msWrite ms input
267+ msWrite handle input
268+ msClose handle
270269 threadDelay 1000
271270 headers <- I.readIORef iheaders
272271 headers `shouldBe`
@@ -282,14 +281,16 @@ spec = do
282281 liftIO $ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ())
283282 atomically $ modifyTVar countVar (+ 1)
284283 f $ responseLBS status200 [] ""
285− withApp defaultSettings app $ withMySocket $ \ms -> do
284+ withApp defaultSettings app $ \port -> do
285+ handle <- connectTo port
286286 let input = S.concat
287287 [ "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"
288288 , "c\r\nHello World\n\r\n3\r\nBye\r\n0\r\n\r\n"
289289 , "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"
290290 , "b\r\nHello World\r\n0\r\n\r\n"
291291 ]
292− msWrite ms input
292+ msWrite handle input
293+ msClose handle
293294 atomically $ do
294295 count <- readTVar countVar
295296 check $ count == 2
@@ -306,12 +307,14 @@ spec = do
306307 I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ())
307308 atomically $ modifyTVar countVar (+ 1)
308309 f $ responseLBS status200 [] ""
309− withApp defaultSettings app $ withMySocket $ \ms -> do
310+ withApp defaultSettings app $ \port -> do
311+ handle <- connectTo port
310312 let input = concat $ replicate 2 $
311313 ["POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"] ++
312314 (replicate 50 "5\r\n12345\r\n") ++
313315 ["0\r\n\r\n"]
314− mapM_ (msWrite ms) input
316+ mapM_ (msWrite handle) input
317+ msClose handle
315318 atomically $ do
316319 count <- readTVar countVar
317320 check $ count == 2
@@ -327,14 +330,16 @@ spec = do
327330 liftIO $ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ())
328331 atomically $ modifyTVar countVar (+ 1)
329332 f $ responseLBS status200 [] ""
330− withApp defaultSettings app $ withMySocket $ \ms -> do
333+ withApp defaultSettings app $ \port -> do
334+ handle <- connectTo port
331335 let input = S.concat
332336 [ "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"
333337 , "c\r\nHello World\n\r\n3\r\nBye\r\n0\r\n"
334338 , "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"
335339 , "b\r\nHello World\r\n0\r\n\r\n"
336340 ]
337− mapM_ (msWrite ms) $ map S.singleton $ S.unpack input
341+ mapM_ (msWrite handle) $ map S.singleton $ S.unpack input
342+ msClose handle
338343 atomically $ do
339344 count <- readTVar countVar
340345 check $ count == 2
@@ -355,18 +360,20 @@ spec = do
355360 E.throwIO (e :: E.SomeException)
356361 liftIO $ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ())
357362 f $ responseLBS status200 [] ""
358− withApp (setTimeout 1 defaultSettings) app $ withMySocket $ \ms -> do
363+ withApp (setTimeout 1 defaultSettings) app $ \port -> do
359364 let bs1 = S.replicate 2048 88
360365 bs2 = "This is short"
361366 bs = S.append bs1 bs2
362− msWrite ms "POST / HTTP/1.1\r\n"
363− msWrite ms "content-length: "
364− msWrite ms $ S8.pack $ show $ S.length bs
365− msWrite ms "\r\n\r\n"
367+ handle <- connectTo port
368+ msWrite handle "POST / HTTP/1.1\r\n"
369+ msWrite handle "content-length: "
370+ msWrite handle $ S8.pack $ show $ S.length bs
371+ msWrite handle "\r\n\r\n"
366372 threadDelay 100000
367− msWrite ms bs1
373+ msWrite handle bs1
368374 threadDelay 100000
369− msWrite ms bs2
375+ msWrite handle bs2
376+ msClose handle
370377 threadDelay 5000000
371378 front <- I.readIORef ifront
372379 S.concat (front []) `shouldBe` bs
@@ -382,7 +389,8 @@ spec = do
382389 loop
383390 loop
384391 doubleBS = S.concatMap $ \w -> S.pack [w, w]
385− withApp defaultSettings app $ withMySocket $ \ms -> do
392+ withApp defaultSettings app $ \port -> do
393+ ms <- connectTo port
386394 msWrite ms "POST / HTTP/1.1\r\n\r\n12345"
387395 timeout 100000 (msRead ms 10) >>= (`shouldBe` Just "1122334455")
388396 msWrite ms "67890"
@@ -410,14 +418,15 @@ spec = do
410418 atomically $ modifyTVar countVar (+ 1)
411419 loop
412420 loop
413− withApp defaultSettings app $ withMySocket $ \ms -> do
414− msWrite ms "POST / HTTP/1.1\r\ntransfer-encoding: chunked\r\n\r\n"
421+ withApp defaultSettings app $ \port -> do
422+ (sock, _addr) <- getSocketTCP "127.0.0.1" port
423+ sendAll sock "POST / HTTP/1.1\r\ntransfer-encoding: chunked\r\n\r\n"
415424 threadDelay 10000
416− msWrite ms "5\r\nhello\r\n0\r\n\r\n"
425+ sendAll sock "5\r\nhello\r\n0\r\n\r\n"
417426 atomically $ do
418427 count <- readTVar countVar
419428 check $ count >= 1
420− bs <- safeRecv (msSocket ms) 4096 -- must not use msRead
429+ bs <- safeRecv sock 4096
421430 S.takeWhile (/= 13) bs `shouldBe` "HTTP/1.1 200 OK"
422431
423432 it "streaming response with length" $ do