@@ -1,14 +1,20 @@
11module Main where
22
3+import Prelude hiding (catch)
34import TestTransport
5+import TestAuxiliary (forkTry, runTest)
46import Network.Transport
57import Network.Transport.TCP (createTransport)
68import Data.Int (Int32)
79import Data.Maybe (fromJust)
8−import Control.Concurrent (forkIO)
9−import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar, readMVar)
10−import Control.Monad (replicateM)
11−import Network.Transport.TCP (decodeEndPointAddress, EndPointId, ControlHeader(..), ConnectionRequestResponse(..))
10+import Control.Concurrent (threadDelay)
11+import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar, readMVar, isEmptyMVar)
12+import Control.Monad (replicateM, guard)
13+import Network.Transport.TCP ( decodeEndPointAddress
14+ , EndPointId
15+ , ControlHeader(..)
16+ , ConnectionRequestResponse(..)
17+ )
1218import Network.Transport.Internal (encodeInt32, prependLength, tlog)
1319import Network.Transport.Internal.TCP (recvInt32)
1420import qualified Network.Socket as N ( getAddrInfo
@@ -34,8 +40,8 @@ testEarlyDisconnect = do
3440 serverDone <- newEmptyMVar
3541 Right transport <- createTransport "127.0.0.1" "8081"
3642
37− forkIO $ server transport serverAddr serverDone
38− forkIO $ client transport serverAddr
43+ forkTry $ server transport serverAddr serverDone
44+ forkTry $ client transport serverAddr
3945
4046 takeMVar serverDone
4147 where
@@ -72,6 +78,36 @@ testEarlyDisconnect = do
7278 -- The server should still receive a ConnectionClosed message
7379 N.sClose sock
7480
81+-- | Test the creation of a transport with an invalid address
82+testInvalidAddress :: IO ()
83+testInvalidAddress = do
84+ Left _ <- createTransport "invalidHostName" "8082"
85+ return ()
86+
87+-- | Test connecting to invalid or non-existing endpoints
88+testInvalidConnect :: IO ()
89+testInvalidConnect = do
90+ Right transport <- createTransport "127.0.0.1" "8083"
91+ Right endpoint <- newEndPoint transport
92+
93+ -- Syntax error in the endpoint address
94+ Left (FailedWith ConnectInvalidAddress _) <-
95+ connect endpoint (EndPointAddress "InvalidAddress") ReliableOrdered
96+
97+ -- Syntax connect, but invalid hostname (TCP address lookup failure)
98+ Left (FailedWith ConnectInvalidAddress _) <-
99+ connect endpoint (EndPointAddress "invalidHost:port:0") ReliableOrdered
100+
101+ -- TCP address correct, but nobody home at that address
102+ Left (FailedWith ConnectFailed _) <-
103+ connect endpoint (EndPointAddress "127.0.0.1:9000:0") ReliableOrdered
104+
105+ -- Valid TCP address but invalid endpoint number
106+ Left (FailedWith ConnectInvalidAddress _) <-
107+ connect endpoint (EndPointAddress "127.0.0.1:8083:1") ReliableOrdered
108+
109+ return ()
110+
75111-- | Test that an endpoint can ignore CloseSocket requests (in "reality" this
76112-- would happen when the endpoint sends a new connection request before
77113-- receiving an (already underway) CloseSocket request)
@@ -81,8 +117,8 @@ testIgnoreCloseSocket = do
81117 clientDone <- newEmptyMVar
82118 Right transport <- createTransport "127.0.0.1" "8084"
83119
84− forkIO $ server transport serverAddr
85− forkIO $ client transport serverAddr clientDone
120+ forkTry $ server transport serverAddr
121+ forkTry $ client transport serverAddr clientDone
86122
87123 takeMVar clientDone
88124
@@ -163,41 +199,100 @@ testIgnoreCloseSocket = do
163199
164200 putMVar clientDone ()
165201
166−-- | Test the creation of a transport with an invalid address
167−testInvalidAddress :: IO ()
168−testInvalidAddress = do
169− Left _ <- createTransport "invalidHostName" "8082"
170− return ()
202+-- | Like 'testIgnoreSocket', but now the server requests a connection after the
203+-- client closed their connection. In the meantime, the server will have sent a
204+-- CloseSocket request to the client, and must block until the client responds.
205+testBlockAfterCloseSocket :: IO ()
206+testBlockAfterCloseSocket = do
207+ serverAddr <- newEmptyMVar
208+ clientAddr <- newEmptyMVar
209+ clientDone <- newEmptyMVar
210+ Right transport <- createTransport "127.0.0.1" "8085"
211+
212+ forkTry $ server transport serverAddr clientAddr
213+ forkTry $ client transport serverAddr clientAddr clientDone
214+
215+ takeMVar clientDone
171216
172−-- | Test connecting to invalid or non-existing endpoints
173−testInvalidConnect :: IO ()
174−testInvalidConnect = do
175− Right transport <- createTransport "127.0.0.1" "8083"
176− Right endpoint <- newEndPoint transport
217+ where
218+ server :: Transport -> MVar (N.HostName, N.ServiceName, EndPointId) -> MVar EndPointAddress -> IO ()
219+ server transport serverAddr clientAddr = do
220+ tlog "Server"
221+ Right endpoint <- newEndPoint transport
222+ putMVar serverAddr (fromJust . decodeEndPointAddress . address $ endpoint)
177223
178− -- Syntax error in the endpoint address
179− Left (FailedWith ConnectInvalidAddress _) <-
180− connect endpoint (EndPointAddress "InvalidAddress") ReliableOrdered
181−
182− -- Syntax connect, but invalid hostname (TCP address lookup failure)
183− Left (FailedWith ConnectInvalidAddress _) <-
184− connect endpoint (EndPointAddress "invalidHost:port:0") ReliableOrdered
185−
186− -- TCP address correct, but nobody home at that address
187− Left (FailedWith ConnectFailed _) <-
188− connect endpoint (EndPointAddress "127.0.0.1:9000:0") ReliableOrdered
224+ -- Wait for the client to connect and disconnect
225+ tlog "Waiting for ConnectionOpened"
226+ ConnectionOpened _ _ _ <- receive endpoint
227+ tlog "Waiting for ConnectionClosed"
228+ ConnectionClosed _ <- receive endpoint
189229
190− -- Valid TCP address but invalid endpoint number
191− Left (FailedWith ConnectInvalidAddress _) <-
192− connect endpoint (EndPointAddress "127.0.0.1:8083:1") ReliableOrdered
230+ -- At this point the server will have sent a CloseSocket request to the
231+ -- client, and must block until the client responds
232+ tlog "Server waiting to connect to the client.."
233+ Right conn <- readMVar clientAddr >>= \addr -> connect endpoint addr ReliableOrdered
234+
235+
236+ tlog "Server waiting.."
193237
194− return ()
238+ client :: Transport -> MVar (N.HostName, N.ServiceName, EndPointId) -> MVar EndPointAddress -> MVar () -> IO ()
239+ client transport serverAddr clientAddr clientDone = do
240+ tlog "Client"
241+ Right endpoint <- newEndPoint transport
242+ putMVar clientAddr (address endpoint)
243+ let EndPointAddress myAddress = address endpoint
244+
245+ -- Connect to the server
246+ addr:_ <- N.getAddrInfo Nothing (Just "127.0.0.1") (Just "8084")
247+ sock <- N.socket (N.addrFamily addr) N.Stream N.defaultProtocol
248+ N.setSocketOption sock N.ReuseAddr 1
249+ N.connect sock (N.addrAddress addr)
250+
251+ tlog "Connecting to endpoint"
252+ (_, _, endPointIx) <- readMVar serverAddr
253+ sendMany sock (encodeInt32 endPointIx : prependLength [myAddress])
254+
255+ -- Wait for acknowledgement
256+ ConnectionRequestAccepted <- recvInt32 sock
257+
258+ -- Request a new connection
259+ tlog "Requesting connection"
260+ let reqId = 0 :: Int32
261+ sendMany sock [encodeInt32 RequestConnectionId, encodeInt32 reqId]
262+ response <- replicateM 4 $ recvInt32 sock :: IO [Int32]
263+
264+ -- Close the connection again
265+ tlog "Closing connection"
266+ sendMany sock [encodeInt32 CloseConnection, encodeInt32 (response !! 3)]
267+
268+ -- Server will now send a CloseSocket request as its refcount reached 0
269+ tlog "Waiting for CloseSocket request"
270+ CloseSocket <- recvInt32 sock
271+
272+ unblocked <- newEmptyMVar
273+
274+ -- We should not hear from the server until we unblock him by
275+ -- responding to the CloseSocket request (in this case, we
276+ -- respond by sending a ConnectionRequest)
277+ forkTry $ do
278+ recvInt32 sock :: IO Int32
279+ isEmptyMVar unblocked >>= guard . not
280+ putMVar clientDone ()
281+
282+ threadDelay 1000000
283+
284+ tlog "Client ignores close socket and sends connection request"
285+ tlog "This should unblock the server"
286+ putMVar unblocked ()
287+ let reqId' = 1 :: Int32
288+ sendMany sock [encodeInt32 RequestConnectionId, encodeInt32 reqId']
195289
196290main :: IO ()
197291main = do
198− runTestIO "EarlyDisconnect" testEarlyDisconnect
199− runTestIO "InvalidAddress" testInvalidAddress
200− runTestIO "InvalidConnect" testInvalidConnect
201− runTestIO "IgnoreCloseSocket" testIgnoreCloseSocket
292+ runTest "EarlyDisconnect" testEarlyDisconnect
293+ runTest "InvalidAddress" testInvalidAddress
294+ runTest "InvalidConnect" testInvalidConnect
295+ runTest "IgnoreCloseSocket" testIgnoreCloseSocket
296+ runTest "BlockAfterCloseSocket" testBlockAfterCloseSocket
202297 Right transport <- createTransport "127.0.0.1" "8080"
203298 testTransport transport