@@ -10,8 +10,8 @@ import Network.Transport.TCP (createTransport, encodeEndPointAddress)
1010import Data.Int (Int32)
1111import Data.Maybe (fromJust)
1212import Control.Concurrent (threadDelay)
13−import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar, readMVar, isEmptyMVar)
14−import Control.Monad (replicateM, guard)
13+import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar, readMVar, isEmptyMVar, tryTakeMVar)
14+import Control.Monad (replicateM, guard, forM_)
1515import Control.Applicative ((<$>))
1616import Control.Exception (throw)
1717import Network.Transport.TCP ( decodeEndPointAddress
@@ -54,8 +54,8 @@ instance Traceable N.AddrInfo where
5454
5555-- Test that the server gets a ConnectionClosed message when the client closes
5656-- the socket without sending an explicit control message to the server first
57−testEarlyDisconnect :: IO ()
58−testEarlyDisconnect = do
57+testEarlyDisconnect :: IO N.ServiceName -> IO ()
58+testEarlyDisconnect nextPort = do
5959 clientAddr <- newEmptyMVar
6060 serverAddr <- newEmptyMVar
6161 serverDone <- newEmptyMVar
@@ -66,12 +66,12 @@ testEarlyDisconnect = do
6666
6767 takeMVar serverDone
6868 where
69− server :: MVar (N.HostName, N.ServiceName, EndPointId) -> MVar EndPointAddress -> MVar () -> IO ()
69+ server :: MVar EndPointAddress -> MVar EndPointAddress -> MVar () -> IO ()
7070 server serverAddr clientAddr serverDone = do
7171 tlog "Server"
72− Right transport <- createTransport "127.0.0.1" "8081"
73− Right endpoint <- newEndPoint transport
74− putMVar serverAddr (fromJust . decodeEndPointAddress . address $ endpoint)
72+ Right transport <- nextPort >>= createTransport "127.0.0.1"
73+ Right endpoint <- newEndPoint transport
74+ putMVar serverAddr (address endpoint)
7575 theirAddr <- readMVar clientAddr
7676
7777 -- TEST 1: they connect to us, then drop the connection
@@ -106,15 +106,16 @@ testEarlyDisconnect = do
106106 -- *Pfew*
107107 putMVar serverDone ()
108108
109− client :: MVar (N.HostName, N.ServiceName, EndPointId) -> MVar EndPointAddress -> IO ()
109+ client :: MVar EndPointAddress -> MVar EndPointAddress -> IO ()
110110 client serverAddr clientAddr = do
111111 tlog "Client"
112− let ourAddress = encodeEndPointAddress "127.0.0.1" "8082" 0
112+ clientPort <- nextPort
113+ let ourAddress = encodeEndPointAddress "127.0.0.1" clientPort 0
113114 putMVar clientAddr ourAddress
114− (_, _, endPointIx) <- readMVar serverAddr
115+ (serverHost, serverPort, endPointIx) <- fromJust . decodeEndPointAddress <$> readMVar serverAddr
115116
116117 -- Listen for incoming messages
117− forkServer "127.0.0.1" "8082" 5 throw $ \sock -> do
118+ forkServer "127.0.0.1" clientPort 5 throw $ \sock -> do
118119 -- Initial setup
119120 0 <- recvInt32 sock :: IO Int
120121 _ <- recvWithLength sock
@@ -140,7 +141,7 @@ testEarlyDisconnect = do
140141 N.sClose sock
141142
142143 -- Connect to the server
143− addr:_ <- N.getAddrInfo Nothing (Just "127.0.0.1") (Just "8081")
144+ addr:_ <- N.getAddrInfo Nothing (Just serverHost) (Just serverPort)
144145 sock <- N.socket (N.addrFamily addr) N.Stream N.defaultProtocol
145146 N.setSocketOption sock N.ReuseAddr 1
146147 N.connect sock (N.addrAddress addr)
@@ -155,20 +156,134 @@ testEarlyDisconnect = do
155156 sendMany sock [encodeInt32 RequestConnectionId, encodeInt32 reqId]
156157
157158 -- Close the socket without closing the connection explicitly
158− -- The server should still receive a ConnectionClosed message
159+ -- The server should receive an error event
159160 N.sClose sock
160161
162+-- | Test the behaviour of a premature CloseSocket request
163+testEarlyCloseSocket :: IO N.ServiceName -> IO ()
164+testEarlyCloseSocket nextPort = do
165+ clientAddr <- newEmptyMVar
166+ serverAddr <- newEmptyMVar
167+ serverDone <- newEmptyMVar
168+
169+ tlog "testEarlyDisconnect"
170+ forkTry $ server serverAddr clientAddr serverDone
171+ forkTry $ client serverAddr clientAddr
172+
173+ takeMVar serverDone
174+ where
175+ server :: MVar EndPointAddress -> MVar EndPointAddress -> MVar () -> IO ()
176+ server serverAddr clientAddr serverDone = do
177+ tlog "Server"
178+ Right transport <- nextPort >>= createTransport "127.0.0.1"
179+ Right endpoint <- newEndPoint transport
180+ putMVar serverAddr (address endpoint)
181+ theirAddr <- readMVar clientAddr
182+
183+ -- TEST 1: they connect to us, then send a CloseSocket. Since we don't
184+ -- have any outgoing connections, this means we will agree to close the
185+ -- socket
186+ do
187+ ConnectionOpened cid _ addr <- receive endpoint
188+ True <- return $ addr == theirAddr
189+
190+ ConnectionClosed cid' <- receive endpoint
191+ True <- return $ cid' == cid
192+
193+ return ()
194+
195+ -- TEST 2: after they dropped their connection to us, we now try to
196+ -- establish a connection to them. This should re-establish the broken
197+ -- TCP connection.
198+ tlog "Trying to connect to client"
199+ Right conn <- connect endpoint theirAddr ReliableOrdered
200+
201+ -- TEST 3: To test the connection, we do a simple ping test; as before,
202+ -- however, the remote client won't close the connection nicely but just
203+ -- sends a CloseSocket -- except that now we *do* have outgoing
204+ -- connections, so we won't agree and hence will receive an error when
205+ -- the socket gets closed
206+ do
207+ Right () <- send conn ["ping"]
208+ ConnectionOpened cid _ addr <- receive endpoint ; True <- return $ addr == theirAddr
209+ Received cid' ["pong"] <- receive endpoint ; True <- return $ cid' == cid
210+ ConnectionClosed cid'' <- receive endpoint ; True <- return $ cid'' == cid
211+ ErrorEvent (ErrorEventConnectionLost addr' []) <- receive endpoint ; True <- return $ addr' == theirAddr
212+ return ()
213+
214+ -- TEST 4: A subsequent send on an already-open connection will now break
215+ Left (FailedWith SendConnectionClosed _) <- send conn ["ping2"]
216+
217+ -- *Pfew*
218+ putMVar serverDone ()
219+
220+ client :: MVar EndPointAddress -> MVar EndPointAddress -> IO ()
221+ client serverAddr clientAddr = do
222+ tlog "Client"
223+ clientPort <- nextPort
224+ let ourAddress = encodeEndPointAddress "127.0.0.1" clientPort 0
225+ putMVar clientAddr ourAddress
226+ (serverHost, serverPort, endPointIx) <- fromJust . decodeEndPointAddress <$> readMVar serverAddr
227+
228+ -- Listen for incoming messages
229+ forkServer "127.0.0.1" clientPort 5 throw $ \sock -> do
230+ -- Initial setup
231+ 0 <- recvInt32 sock :: IO Int
232+ _ <- recvWithLength sock
233+ sendMany sock [encodeInt32 ConnectionRequestAccepted]
234+
235+ -- Server requests a logical connection
236+ RequestConnectionId <- toEnum <$> (recvInt32 sock :: IO Int)
237+ reqId <- recvInt32 sock :: IO Int
238+ sendMany sock (encodeInt32 ControlResponse : encodeInt32 reqId : prependLength [encodeInt32 (10001 :: Int)])
239+
240+ -- Server sends a message
241+ 10001 <- recvInt32 sock :: IO Int
242+ ["ping"] <- recvWithLength sock
243+
244+ -- Reply
245+ sendMany sock [encodeInt32 RequestConnectionId, encodeInt32 (10002 :: Int)]
246+ ControlResponse <- toEnum <$> (recvInt32 sock :: IO Int)
247+ 10002 <- recvInt32 sock :: IO Int
248+ [cid] <- recvWithLength sock
249+ sendMany sock (cid : prependLength ["pong"])
250+
251+ -- Send a CloseSocket even though there are still connections *in both
252+ -- directions*
253+ sendMany sock [encodeInt32 CloseSocket]
254+ N.sClose sock
255+
256+ -- Connect to the server
257+ addr:_ <- N.getAddrInfo Nothing (Just serverHost) (Just serverPort)
258+ sock <- N.socket (N.addrFamily addr) N.Stream N.defaultProtocol
259+ N.setSocketOption sock N.ReuseAddr 1
260+ N.connect sock (N.addrAddress addr)
261+
262+ sendMany sock (encodeInt32 endPointIx : prependLength [endPointAddressToByteString ourAddress])
263+
264+ -- Wait for acknowledgement
265+ ConnectionRequestAccepted <- toEnum <$> recvInt32 sock
266+
267+ -- Request a new connection, but don't wait for the response
268+ let reqId = 0 :: Int32
269+ sendMany sock [encodeInt32 RequestConnectionId, encodeInt32 reqId]
270+
271+ -- Send a CloseSocket without sending a closeconnecton
272+ -- The server should still receive a ConnectionClosed message
273+ sendMany sock [encodeInt32 CloseSocket]
274+ N.sClose sock
161275
162276-- | Test the creation of a transport with an invalid address
163−testInvalidAddress :: IO ()
164−testInvalidAddress = do
165− Left _ <- createTransport "invalidHostName" "8082"
277+testInvalidAddress :: IO N.ServiceName -> IO ()
278+testInvalidAddress nextPort = do
279+ Left _ <- nextPort >>= createTransport "invalidHostName"
166280 return ()
167281
168282-- | Test connecting to invalid or non-existing endpoints
169−testInvalidConnect :: IO ()
170−testInvalidConnect = do
171− Right transport <- createTransport "127.0.0.1" "8083"
283+testInvalidConnect :: IO N.ServiceName -> IO ()
284+testInvalidConnect nextPort = do
285+ port <- nextPort
286+ Right transport <- createTransport "127.0.0.1" port
172287 Right endpoint <- newEndPoint transport
173288
174289 -- Syntax error in the endpoint address
@@ -177,26 +292,26 @@ testInvalidConnect = do
177292
178293 -- Syntax connect, but invalid hostname (TCP address lookup failure)
179294 Left (FailedWith ConnectInvalidAddress _) <-
180− connect endpoint (EndPointAddress "invalidHost:port:0") ReliableOrdered
295+ connect endpoint (encodeEndPointAddress "invalidHost" "port" 0) ReliableOrdered
181296
182297 -- TCP address correct, but nobody home at that address
183298 Left (FailedWith ConnectFailed _) <-
184− connect endpoint (EndPointAddress "127.0.0.1:9000:0") ReliableOrdered
299+ connect endpoint (encodeEndPointAddress "127.0.0.1" "9000" 0) ReliableOrdered
185300
186301 -- Valid TCP address but invalid endpoint number
187302 Left (FailedWith ConnectInvalidAddress _) <-
188− connect endpoint (EndPointAddress "127.0.0.1:8083:1") ReliableOrdered
303+ connect endpoint (encodeEndPointAddress "127.0.0.1" port 1) ReliableOrdered
189304
190305 return ()
191306
192307-- | Test that an endpoint can ignore CloseSocket requests (in "reality" this
193308-- would happen when the endpoint sends a new connection request before
194309-- receiving an (already underway) CloseSocket request)
195−testIgnoreCloseSocket :: IO ()
196−testIgnoreCloseSocket = do
310+testIgnoreCloseSocket :: IO N.ServiceName -> IO ()
311+testIgnoreCloseSocket nextPort = do
197312 serverAddr <- newEmptyMVar
198313 clientDone <- newEmptyMVar
199− Right transport <- createTransport "127.0.0.1" "8084"
314+ Right transport <- nextPort >>= createTransport "127.0.0.1"
200315
201316 forkTry $ server transport serverAddr
202317 forkTry $ client transport serverAddr clientDone
@@ -232,15 +347,15 @@ testIgnoreCloseSocket = do
232347 tlog "Client"
233348 Right endpoint <- newEndPoint transport
234349 let EndPointAddress myAddress = address endpoint
350+ (serverHost, serverPort, endPointIx) <- readMVar serverAddr
235351
236352 -- Connect to the server
237− addr:_ <- N.getAddrInfo Nothing (Just "127.0.0.1") (Just "8084")
353+ addr:_ <- N.getAddrInfo Nothing (Just serverHost) (Just serverPort)
238354 sock <- N.socket (N.addrFamily addr) N.Stream N.defaultProtocol
239355 N.setSocketOption sock N.ReuseAddr 1
240356 N.connect sock (N.addrAddress addr)
241357
242358 tlog "Connecting to endpoint"
243− (_, _, endPointIx) <- readMVar serverAddr
244359 sendMany sock (encodeInt32 endPointIx : prependLength [myAddress])
245360
246361 -- Wait for acknowledgement
@@ -283,12 +398,13 @@ testIgnoreCloseSocket = do
283398-- | Like 'testIgnoreSocket', but now the server requests a connection after the
284399-- client closed their connection. In the meantime, the server will have sent a
285400-- CloseSocket request to the client, and must block until the client responds.
286−testBlockAfterCloseSocket :: IO ()
287−testBlockAfterCloseSocket = do
401+testBlockAfterCloseSocket :: IO N.ServiceName -> IO ()
402+testBlockAfterCloseSocket nextPort = do
288403 serverAddr <- newEmptyMVar
289404 clientAddr <- newEmptyMVar
290405 clientDone <- newEmptyMVar
291− Right transport <- createTransport "127.0.0.1" "8085"
406+ port <- nextPort
407+ Right transport <- createTransport "127.0.0.1" port
292408
293409 forkTry $ server transport serverAddr clientAddr
294410 forkTry $ client transport serverAddr clientAddr clientDone
@@ -321,15 +437,15 @@ testBlockAfterCloseSocket = do
321437 Right endpoint <- newEndPoint transport
322438 putMVar clientAddr (address endpoint)
323439 let EndPointAddress myAddress = address endpoint
440+ (serverHost, serverPort, endPointIx) <- readMVar serverAddr
324441
325442 -- Connect to the server
326− addr:_ <- N.getAddrInfo Nothing (Just "127.0.0.1") (Just "8084")
443+ addr:_ <- N.getAddrInfo Nothing (Just serverHost) (Just serverPort)
327444 sock <- N.socket (N.addrFamily addr) N.Stream N.defaultProtocol
328445 N.setSocketOption sock N.ReuseAddr 1
329446 N.connect sock (N.addrAddress addr)
330447
331448 tlog "Connecting to endpoint"
332− (_, _, endPointIx) <- readMVar serverAddr
333449 sendMany sock (encodeInt32 endPointIx : prependLength [myAddress])
334450
335451 -- Wait for acknowledgement
@@ -369,12 +485,16 @@ testBlockAfterCloseSocket = do
369485
370486main :: IO ()
371487main = do
488+ portMVar <- newEmptyMVar
489+ forkTry $ forM_ ([10080 .. 10087] :: [Int]) $ putMVar portMVar . show
490+ let nextPort = do Just port <- tryTakeMVar portMVar ; return port
372491 tryIO $ runTests
373− [ ("EarlyDisconnect", testEarlyDisconnect)
374− , ("InvalidAddress", testInvalidAddress)
375− , ("InvalidConnect", testInvalidConnect)
376− , ("IgnoreCloseSocket", testIgnoreCloseSocket)
377− , ("BlockAfterCloseSocket", testBlockAfterCloseSocket)
492+ [ ("EarlyDisconnect", testEarlyDisconnect nextPort)
493+ , ("EarlyCloseSocket", testEarlyCloseSocket nextPort)
494+ , ("IgnoreCloseSocket", testIgnoreCloseSocket nextPort)
495+ , ("BlockAfterCloseSocket", testBlockAfterCloseSocket nextPort)
496+ , ("InvalidAddress", testInvalidAddress nextPort)
497+ , ("InvalidConnect", testInvalidConnect nextPort)
378498 ]
379499 Right transport <- createTransport "127.0.0.1" "8080"
380500 testTransport transport