git.iko.soy/distributed-process
on master help sign in
Reenable the early disconnect test
8690391Edsko de Vries
network-transport-2/src/Network/Transport/TCP.hs+3−2
compare with master
unifiedsplit
@@ -6,12 +6,13 @@
6-- @192.168.0.1:8080@ and /B/ subsequently connects tries to connect to /A/ as
6-- @192.168.0.1:8080@ and /B/ subsequently connects tries to connect to /A/ as
7-- @client1.local:http-alt@ then the transport layer will not realize that the
7-- @client1.local:http-alt@ then the transport layer will not realize that the
8-- TCP connection can be reused.
8-- TCP connection can be reused.
9−module Network.Transport.TCP {- ( -- * Main API
9+module Network.Transport.TCP ( -- * Main API
10 createTransport
10 createTransport
11 , -- * TCP specific functionality
11 , -- * TCP specific functionality
12 EndPointId
12 EndPointId
13 , decodeEndPointAddress
13 , decodeEndPointAddress
14 , ControlHeader(..)
14 , ControlHeader(..)
15+ , ConnectionRequestResponse(..)
15 -- * Design notes
16 -- * Design notes
16 -- ** Overview
17 -- ** Overview
17 -- $overview
18 -- $overview
@@ -19,7 +20,7 @@ module Network.Transport.TCP {- ( -- * Main API
19 -- $connecting
20 -- $connecting
20 -- ** Disconnecting
21 -- ** Disconnecting
21 -- $disconnecting
22 -- $disconnecting
22− ) -} where
23+ ) where
23
24
24import Network.Transport
25import Network.Transport
25import Network.Transport.Internal.TCP ( forkServer
26import Network.Transport.Internal.TCP ( forkServer
network-transport-2/tests/TestTCP.hs+7−8
@@ -3,12 +3,11 @@ module Main where
3import TestTransport
3import TestTransport
4import Network.Transport
4import Network.Transport
5import Network.Transport.TCP (createTransport)
5import Network.Transport.TCP (createTransport)
6−{-
7import Data.Int (Int32)
6import Data.Int (Int32)
8import Data.Maybe (fromJust)
7import Data.Maybe (fromJust)
9import Control.Concurrent (forkIO)
8import Control.Concurrent (forkIO)
10import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar, readMVar)
9import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar, readMVar)
11−import Network.Transport.TCP (decodeEndPointAddress, EndPointId, ControlHeader(..))
10+import Network.Transport.TCP (decodeEndPointAddress, EndPointId, ControlHeader(..), ConnectionRequestResponse(..))
12import Network.Transport.Internal (encodeInt32, prependLength)
11import Network.Transport.Internal (encodeInt32, prependLength)
13import Network.Transport.Internal.TCP (recvInt32)
12import Network.Transport.Internal.TCP (recvInt32)
14import qualified Network.Socket as N ( getAddrInfo
13import qualified Network.Socket as N ( getAddrInfo
@@ -25,11 +24,10 @@ import qualified Network.Socket as N ( getAddrInfo
25 , ServiceName
24 , ServiceName
26 )
25 )
27import Network.Socket.ByteString (sendMany)
26import Network.Socket.ByteString (sendMany)
28−-}
29
27
28+-- Test that the server gets a ConnectionClosed message when the client closes
29+-- the socket without sending an explicit control message to the server first
30testEarlyDisconnect :: IO ()
30testEarlyDisconnect :: IO ()
31−testEarlyDisconnect = return ()
32−{-
33testEarlyDisconnect = do
31testEarlyDisconnect = do
34 serverAddr <- newEmptyMVar
32 serverAddr <- newEmptyMVar
35 serverDone <- newEmptyMVar
33 serverDone <- newEmptyMVar
@@ -63,7 +61,7 @@ testEarlyDisconnect = do
63 sendMany sock (encodeInt32 endPointIx : prependLength [myAddress])
61 sendMany sock (encodeInt32 endPointIx : prependLength [myAddress])
64
62
65 -- Wait for acknowledgement
63 -- Wait for acknowledgement
66− ValidEndPoint <- recvInt32 sock
64+ ConnectionRequestAccepted <- recvInt32 sock
67
65
68 -- Request a new connection, but don't wait for the response
66 -- Request a new connection, but don't wait for the response
69 let reqId = 0 :: Int32
67 let reqId = 0 :: Int32
@@ -72,13 +70,14 @@ testEarlyDisconnect = do
72 -- Close the socket without closing the connection explicitly
70 -- Close the socket without closing the connection explicitly
73 -- The server should still receive a ConnectionClosed message
71 -- The server should still receive a ConnectionClosed message
74 N.sClose sock
72 N.sClose sock
75−-}
76
73
74+-- | Test the creation of a transport with an invalid address
77testInvalidAddress :: IO ()
75testInvalidAddress :: IO ()
78testInvalidAddress = do
76testInvalidAddress = do
79 Left _ <- createTransport "invalidHostName" "8082"
77 Left _ <- createTransport "invalidHostName" "8082"
80 return ()
78 return ()
81
79
80+-- | Test connecting to invalid or non-existing endpoints
82testInvalidConnect :: IO ()
81testInvalidConnect :: IO ()
83testInvalidConnect = do
82testInvalidConnect = do
84 Right transport <- createTransport "127.0.0.1" "8083"
83 Right transport <- createTransport "127.0.0.1" "8083"
@@ -104,7 +103,7 @@ testInvalidConnect = do
104
103
105main :: IO ()
104main :: IO ()
106main = do
105main = do
107− -- runTestIO "EarlyDisconnect" testEarlyDisconnect
106+ runTestIO "EarlyDisconnect" testEarlyDisconnect
108 runTestIO "InvalidAddress" testInvalidAddress
107 runTestIO "InvalidAddress" testInvalidAddress
109 runTestIO "InvalidConnect" testInvalidConnect
108 runTestIO "InvalidConnect" testInvalidConnect
110 Right transport <- createTransport "127.0.0.1" "8080"
109 Right transport <- createTransport "127.0.0.1" "8080"