@@ -13,13 +13,14 @@ import Control.Concurrent (threadDelay)
1313import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar, readMVar, isEmptyMVar)
1414import Control.Monad (replicateM, guard)
1515import Control.Applicative ((<$>))
16+import Control.Exception (throw)
1617import Network.Transport.TCP ( decodeEndPointAddress
1718 , EndPointId
1819 , ControlHeader(..)
1920 , ConnectionRequestResponse(..)
2021 )
2122import Network.Transport.Internal (encodeInt32, prependLength, tlog, tryIO)
22−import Network.Transport.Internal.TCP (recvInt32)
23+import Network.Transport.Internal.TCP (recvInt32, forkServer, recvWithLength)
2324import qualified Network.Socket as N ( getAddrInfo
2425 , socket
2526 , connect
@@ -73,36 +74,37 @@ testEarlyDisconnect = do
7374 putMVar serverAddr (fromJust . decodeEndPointAddress . address $ endpoint)
7475 theirAddr <- readMVar clientAddr
7576
76− -- First test: they connect to us, then drop the connection
77− ConnectionOpened cid _ addr <- receive endpoint
78− True <- return $ addr == theirAddr
77+ -- TEST 1: they connect to us, then drop the connection
78+ do
79+ ConnectionOpened cid _ addr <- receive endpoint
80+ True <- return $ addr == theirAddr
7981
80− ErrorEvent (ErrorEventConnectionLost addr' [cid']) <- receive endpoint
81− True <- return $ addr' == theirAddr && cid' == cid
82+ ErrorEvent (ErrorEventConnectionLost addr' [cid']) <- receive endpoint
83+ True <- return $ addr' == theirAddr && cid' == cid
84+
85+ return ()
8286
83− -- Second test: after they dropped their connection to us, we now try to
87+ -- TEST 2: after they dropped their connection to us, we now try to
8488 -- establish a connection to them. This should re-establish the broken
8589 -- TCP connection.
8690 tlog "Trying to connect to client"
87− Right _ <- connect endpoint theirAddr ReliableOrdered
91+ Right conn <- connect endpoint theirAddr ReliableOrdered
8892
89− putMVar serverDone ()
90−
91−{-
92− -- To test the connection, we do a simple ping test; as before, however,
93− -- the remote client won't close the connection nicely but just closes
94− -- the socket
93+ -- TEST 3: To test the connection, we do a simple ping test; as before,
94+ -- however, the remote client won't close the connection nicely but just
95+ -- closes the socket
9596 do
96− send conn ["ping"]
97− cid <- expect endpoint (\(ConnectionOpened cid _ addr) -> (addr == theirAddr, cid))
98− expect' endpoint (\(Received cid' [msg]) -> cid' == cid && msg == "pong")
99− expect' endpoint (\(ErrorEvent (ErrorEventConnectionLost addr [cid'])) -> addr == theirAddr && cid' == cid)
97+ Right () <- send conn ["ping"]
98+ ConnectionOpened cid _ addr <- receive endpoint ; True <- return $ addr == theirAddr
99+ Received cid' ["pong"] <- receive endpoint ; True <- return $ cid == cid'
100+ ErrorEvent (ErrorEventConnectionLost addr' [cid'']) <- receive endpoint ; True <- return $ addr' == theirAddr && cid'' == cid
101+ return ()
100102
101− -- TODO: we now need to decide (and test) and should happen on a subsequent 'send'
102−
103−-}
104−
103+ -- TEST 4: A subsequent send on an already-open connection will now break
104+ Left (FailedWith SendConnectionClosed _) <- send conn ["ping2"]
105105
106+ -- *Pfew*
107+ putMVar serverDone ()
106108
107109 client :: MVar (N.HostName, N.ServiceName, EndPointId) -> MVar EndPointAddress -> IO ()
108110 client serverAddr clientAddr = do
@@ -111,7 +113,31 @@ testEarlyDisconnect = do
111113 putMVar clientAddr ourAddress
112114 (_, _, endPointIx) <- readMVar serverAddr
113115
114−
116+ -- Listen for incoming messages
117+ forkServer "127.0.0.1" "8082" 5 throw $ \sock -> do
118+ -- Initial setup
119+ 0 <- recvInt32 sock :: IO Int
120+ _ <- recvWithLength sock
121+ sendMany sock [encodeInt32 ConnectionRequestAccepted]
122+
123+ -- Server requests a logical connection
124+ RequestConnectionId <- toEnum <$> (recvInt32 sock :: IO Int)
125+ reqId <- recvInt32 sock :: IO Int
126+ sendMany sock (encodeInt32 ControlResponse : encodeInt32 reqId : prependLength [encodeInt32 (10001 :: Int)])
127+
128+ -- Server sends a message
129+ 10001 <- recvInt32 sock :: IO Int
130+ ["ping"] <- recvWithLength sock
131+
132+ -- Reply
133+ sendMany sock [encodeInt32 RequestConnectionId, encodeInt32 (10002 :: Int)]
134+ ControlResponse <- toEnum <$> (recvInt32 sock :: IO Int)
135+ 10002 <- recvInt32 sock :: IO Int
136+ [cid] <- recvWithLength sock
137+ sendMany sock (cid : prependLength ["pong"])
138+
139+ -- Close the socket
140+ N.sClose sock
115141
116142 -- Connect to the server
117143 addr:_ <- N.getAddrInfo Nothing (Just "127.0.0.1") (Just "8081")
@@ -132,6 +158,7 @@ testEarlyDisconnect = do
132158 -- The server should still receive a ConnectionClosed message
133159 N.sClose sock
134160
161+
135162-- | Test the creation of a transport with an invalid address
136163testInvalidAddress :: IO ()
137164testInvalidAddress = do
@@ -344,10 +371,11 @@ main :: IO ()
344371main = do
345372 tryIO $ runTests
346373 [ ("EarlyDisconnect", testEarlyDisconnect)
347− , ("InvalidAddress", testInvalidAddress)
348− , ("InvalidConnect", testInvalidConnect)
349− , ("IgnoreCloseSocket", testIgnoreCloseSocket)
350− , ("BlockAfterCloseSocket", testBlockAfterCloseSocket)
374+ , ("InvalidAddress", testInvalidAddress)
375+ , ("InvalidConnect", testInvalidConnect)
376+ , ("IgnoreCloseSocket", testIgnoreCloseSocket)
377+ , ("BlockAfterCloseSocket", testBlockAfterCloseSocket)
351378 ]
352379 Right transport <- createTransport "127.0.0.1" "8080"
353380 testTransport transport
381+ return ()