@@ -2,7 +2,7 @@
22{-# LANGUAGE OverloadedStrings #-}
33{-# LANGUAGE ScopedTypeVariables #-}
44
5−module RunSpec (main, spec, withApp) where
5+module RunSpec (main, spec, withApp, connectTo) where
66
77import Control.Concurrent (forkIO, killThread, threadDelay)
88import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar)
@@ -17,13 +17,12 @@ import qualified Data.ByteString.Char8 as S8
1717import qualified Data.ByteString.Lazy as L
1818import qualified Data.IORef as I
1919import Data.Streaming.Network (bindPortTCP, getSocketTCP, safeRecv)
20−import Network (connectTo, PortID (PortNumber))
2120import Network.HTTP.Types
22−import Network.Socket (close)
21+import Network.Socket
2322import Network.Socket.ByteString (sendAll)
2423import Network.Wai
2524import Network.Wai.Handler.Warp
26−import System.IO (hFlush, hClose)
25+import System.IO (hFlush, hClose, Handle, IOMode(..))
2726import System.IO.Unsafe (unsafePerformIO)
2827import System.Timeout (timeout)
2928import Test.Hspec
@@ -36,6 +35,14 @@ main = hspec spec
3635type Counter = I.IORef (Either String Int)
3736type CounterApplication = Counter -> Application
3837
38+connectTo :: HostName -> Int -> IO Handle
39+connectTo host port = do
40+ let hints = defaultHints { addrSocketType = Stream }
41+ addr:_ <- getAddrInfo (Just hints) (Just host) (Just $ show port)
42+ sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
43+ connect sock $ addrAddress addr
44+ socketToHandle sock ReadWriteMode
45+
3946incr :: MonadIO m => Counter -> m ()
4047incr icount = liftIO $ I.atomicModifyIORef icount $ \ecount ->
4148 ((case ecount of
@@ -107,7 +114,7 @@ runTest :: Int -- ^ expected number of requests
107114runTest expected app chunks = do
108115 ref <- I.newIORef (Right 0)
109116 withApp defaultSettings (app ref) $ \port -> do
110− handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port
117+ handle <- connectTo "127.0.0.1" port
111118 forM_ chunks $ \chunk -> hPutStr handle chunk >> hFlush handle
112119 _ <- timeout 100000 $ replicateM_ expected $ hGetSome handle 4096
113120 res <- I.readIORef ref
@@ -125,7 +132,7 @@ runTerminateTest expected input = do
125132 ref <- I.newIORef Nothing
126133 let onExc _ = I.writeIORef ref . Just
127134 withApp (setOnException onExc defaultSettings) dummyApp $ \port -> do
128− handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port
135+ handle <- connectTo "127.0.0.1" port
129136 hPutStr handle input
130137 hFlush handle
131138 hClose handle
@@ -200,7 +207,7 @@ spec = do
200207 liftIO $ I.writeIORef iheaders $ requestHeaders req
201208 f $ responseLBS status200 [] ""
202209 withApp defaultSettings app $ \port -> do
203− handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port
210+ handle <- connectTo "127.0.0.1" port
204211 let input = S.concat
205212 [ "GET / HTTP/1.1\r\nfoo: bar\r\n baz\r\n\tbin\r\n\r\n"
206213 ]
@@ -218,7 +225,7 @@ spec = do
218225 liftIO $ I.writeIORef iheaders $ requestHeaders req
219226 f $ responseLBS status200 [] ""
220227 withApp defaultSettings app $ \port -> do
221− handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port
228+ handle <- connectTo "127.0.0.1" port
222229 let input = S.concat
223230 [ "GET / HTTP/1.1\r\nfoo:bar\r\n\r\n"
224231 ]
@@ -239,7 +246,7 @@ spec = do
239246 liftIO $ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ())
240247 f $ responseLBS status200 [] ""
241248 withApp defaultSettings app $ \port -> do
242− handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port
249+ handle <- connectTo "127.0.0.1" port
243250 let input = S.concat
244251 [ "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"
245252 , "c\r\nHello World\n\r\n3\r\nBye\r\n0\r\n\r\n"
@@ -262,7 +269,7 @@ spec = do
262269 I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ())
263270 f $ responseLBS status200 [] ""
264271 withApp defaultSettings app $ \port -> do
265− handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port
272+ handle <- connectTo "127.0.0.1" port
266273 let input = concat $ replicate 2 $
267274 ["POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"] ++
268275 (replicate 50 "5\r\n12345\r\n") ++
@@ -279,7 +286,7 @@ spec = do
279286 liftIO $ I.atomicModifyIORef ifront $ \front -> (front . (S.concat bss:), ())
280287 f $ responseLBS status200 [] ""
281288 withApp defaultSettings app $ \port -> do
282− handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port
289+ handle <- connectTo "127.0.0.1" port
283290 let input = S.concat
284291 [ "POST / HTTP/1.1\r\nTransfer-Encoding: Chunked\r\n\r\n"
285292 , "c\r\nHello World\n\r\n3\r\nBye\r\n0\r\n"
@@ -310,7 +317,7 @@ spec = do
310317 let bs1 = S.replicate 2048 88
311318 bs2 = "This is short"
312319 bs = S.append bs1 bs2
313− handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port
320+ handle <- connectTo "127.0.0.1" port
314321 hPutStr handle "POST / HTTP/1.1\r\n"
315322 hPutStr handle "content-length: "
316323 hPutStr handle $ S8.pack $ show $ S.length bs
@@ -336,7 +343,7 @@ spec = do
336343 loop
337344 doubleBS = S.concatMap $ \w -> S.pack [w, w]
338345 withApp defaultSettings app $ \port -> do
339− handle <- connectTo "127.0.0.1" $ PortNumber $ fromIntegral port
346+ handle <- connectTo "127.0.0.1" port
340347 hPutStr handle "POST / HTTP/1.1\r\n\r\n12345"
341348 hFlush handle
342349 timeout 100000 (S.hGet handle 10) >>= (`shouldBe` Just "1122334455")