f5c847b · distributed-process

git.iko.soy/distributed-process

More consistent errors

commitf5c847babeae39b9ed1f740a8e7e220e7c143db0 authorEdsko de Vries <edsko@edsko.net> dateTue 15 May 2012, 18:34 (14 years ago) parentcd7ec5a

6 files changed+157−107

compare with master

unifiedsplit

network-transport-2/src/Network/Transport.hs+57−29 network-transport-2/src/Network/Transport/Chan.hs+7−7 network-transport-2/src/Network/Transport/TCP.hs+40−39 network-transport-2/tests/TestAuxiliary.hs+1−1 network-transport-2/tests/TestTCP.hs+30−14 network-transport-2/tests/TestTransport.hs+22−17

network-transport-2/src/Network/Transport.hs+57−29

@@ -10,17 +10,16 @@ module Network.Transport ( -- * Types

1010 , EndPointAddress(..)

1111 , MulticastAddress(..)

1212 -- * Error codes

13− , FailedWith(..)

13+ , TransportError(..)

1414 , NewEndPointErrorCode(..)

1515 , ConnectErrorCode(..)

1616 , NewMulticastGroupErrorCode(..)

1717 , ResolveMulticastGroupErrorCode(..)

1818 , SendErrorCode(..)

19− , ErrorEventInfo(..)

19+ , EventErrorCode(..)

2020 ) where

2121

2222import Data.ByteString (ByteString)

23−import Control.Monad.Error (Error(..))

2423import Control.Exception (Exception)

2524import Data.Typeable (Typeable)

2625

@@ -32,7 +31,7 @@ import Data.Typeable (Typeable)

3231-- @Network.Transport.*@ packages.

3332data Transport = Transport {

3433 -- | Create a new end point (heavyweight operation)

35− newEndPoint :: IO (Either (FailedWith NewEndPointErrorCode) EndPoint)

34+ newEndPoint :: IO (Either (TransportError NewEndPointErrorCode) EndPoint)

3635 -- | Shutdown the transport completely

3736 , closeTransport :: IO ()

3837 }

@@ -44,11 +43,11 @@ data EndPoint = EndPoint {

4443 -- | EndPointAddress of the endpoint.

4544 , address :: EndPointAddress

4645 -- | Create a new lightweight connection.

47− , connect :: EndPointAddress -> Reliability -> IO (Either (FailedWith ConnectErrorCode) Connection)

46+ , connect :: EndPointAddress -> Reliability -> IO (Either (TransportError ConnectErrorCode) Connection)

4847 -- | Create a new multicast group.

49− , newMulticastGroup :: IO (Either (FailedWith NewMulticastGroupErrorCode) MulticastGroup)

48+ , newMulticastGroup :: IO (Either (TransportError NewMulticastGroupErrorCode) MulticastGroup)

5049 -- | Resolve an address to a multicast group.

51− , resolveMulticastGroup :: MulticastAddress -> IO (Either (FailedWith ResolveMulticastGroupErrorCode) MulticastGroup)

50+ , resolveMulticastGroup :: MulticastAddress -> IO (Either (TransportError ResolveMulticastGroupErrorCode) MulticastGroup)

5251 -- | Close the endpoint

5352 , closeEndPoint :: IO ()

5453 }

@@ -56,7 +55,7 @@ data EndPoint = EndPoint {

5655-- | Lightweight connection to an endpoint.

5756data Connection = Connection {

5857 -- | Send a message on this connection.

59− send :: [ByteString] -> IO (Either (FailedWith SendErrorCode) ())

58+ send :: [ByteString] -> IO (Either (TransportError SendErrorCode) ())

6059 -- | Close the connection.

6160 , close :: IO ()

6261 }

@@ -71,8 +70,10 @@ data Event =

7170 | ConnectionOpened ConnectionId Reliability EndPointAddress

7271 -- | Received multicast

7372 | ReceivedMulticast MulticastAddress [ByteString]

74− -- | Error that caused a bunch of connections to close (possibly none)

75− | ErrorEvent ErrorEventInfo

73+ -- | The endpoint got closed (manually, by a call to closeEndPoint or closeTransport)

74+ | EndPointClosed

75+ -- | An error occurred

76+ | ErrorEvent (TransportError EventErrorCode)

7677 deriving Show

7778

7879-- | Connection IDs enable receivers to distinguish one connection from another.

@@ -115,50 +116,77 @@ newtype MulticastAddress = MulticastAddress { multicastAddressToByteString :: By

115116-- Error codes --

116117--------------------------------------------------------------------------------

117118

118−data FailedWith error = FailedWith error String

119+data TransportError error = TransportError error String

119120 deriving (Show, Typeable)

120121

121−instance Error (FailedWith error) where

122− strMsg = FailedWith undefined

122+-- | Although the functions in the transport API never throw TransportErrors

123+-- (but return them explicitly), application code may want to turn these into

124+-- exceptions.

125+instance (Typeable err, Show err) => Exception (TransportError err)

123126

124−-- | For internal convenience, FailedWith is declared as an exception type

125−instance (Typeable err, Show err) => Exception (FailedWith err)

126−

127−-- | Errors during the creation of an endpoint (currently, there are none)

127+-- | Errors during the creation of an endpoint

128128data NewEndPointErrorCode =

129− NewEndPointTransportFailure -- ^ Transport-wide failure

129+ -- | Not enough resources

130+ -- (i.e., this could be a temporary local problem)

131+ NewEndPointInsufficientResources

132+ -- | Failed for some other reason

133+ -- (i.e., there is probably no point trying again)

134+ | NewEndPointFailed

130135 deriving (Show, Typeable)

131136

132137-- | Connection failure

133138data ConnectErrorCode =

134− ConnectInvalidAddress -- ^ Could not parse or resolve the address

135− | ConnectInsufficientResources -- ^ Insufficient resources (for instance, no more sockets available)

136− | ConnectFailed -- ^ Failed for other reasons

139+ -- | Could not resolve the address

140+ -- (i.e., this could be a temporary remote problem)

141+ ConnectNotFound

142+ -- | Insufficient resources (for instance, no more sockets available)

143+ -- (i.e., this could be a temporary local problem)

144+ | ConnectInsufficientResources

145+ -- | Failed for other reasons (including syntax error)

146+ -- (i.e., there is probably no point trying again).

147+ | ConnectFailed

137148 deriving (Show, Typeable)

138149

139150-- | Failure during the creation of a new multicast group

140151data NewMulticastGroupErrorCode =

141− NewMulticastGroupUnsupported

152+ -- | Insufficient resources

153+ -- (i.e., this could be a temporary problem)

154+ NewMulticastGroupInsufficientResources

155+ -- | Failed for some other reason

156+ -- (i.e., there is probably no point trying again)

157+ | NewMulticastGroupFailed

158+ -- | Not all transport implementations support multicast

159+ | NewMulticastGroupUnsupported

142160 deriving (Show, Typeable)

143161

144162-- | Failure during the resolution of a multicast group

145163data ResolveMulticastGroupErrorCode =

164+ -- | Multicast group not found

165+ -- (i.e., this could be a temporary problem)

146166 ResolveMulticastGroupNotFound

167+ -- | Failed for some other reason (including syntax error)

168+ -- (i.e., there is probably no point trying again)

169+ | ResolveMulticastGroupFailed

170+ -- | Not all transport implementations support multicast

147171 | ResolveMulticastGroupUnsupported

148172 deriving (Show, Typeable)

149173

150174-- | Failure during sending a message

151175data SendErrorCode =

152− SendConnectionClosed -- ^ Connection was closed manually or because of an error

153− | SendFailed -- ^ Send failed for some other reason

176+ -- | Could not send this message

177+ -- (but another attempt might succeed)

178+ SendUnreachable

179+ -- | Send failed for some other reason

180+ -- (and retrying probably won't help)

181+ | SendFailed

154182 deriving (Show, Typeable)

155183

156184-- | Error codes used when reporting errors to endpoints (through receive)

157−data ErrorEventInfo =

158− -- | Endpoint was closed (manually or because of an error)

159− ErrorEventEndPointClosed [ConnectionId]

185+data EventErrorCode =

186+ -- | Failure of the entire endpoint

187+ EventEndPointFailed

160188 -- | Transport-wide fatal error

161− | ErrorEventTransportFailure

189+ | EventTransportFailed

162190 -- | Connection to a remote endpoint was lost

163− | ErrorEventConnectionLost EndPointAddress [ConnectionId]

191+ | EventConnectionLost EndPointAddress [ConnectionId]

164192 deriving Show

network-transport-2/src/Network/Transport/Chan.hs+7−7

@@ -38,7 +38,7 @@ createTransport = do

3838 }

3939

4040-- | Create a new end point

41−apiNewEndPoint :: MVar TransportState -> IO (Either (FailedWith NewEndPointErrorCode) EndPoint)

41+apiNewEndPoint :: MVar TransportState -> IO (Either (TransportError NewEndPointErrorCode) EndPoint)

4242apiNewEndPoint state = do

4343 chan <- newChan

4444 addr <- modifyMVar state $ \st -> do

@@ -53,7 +53,7 @@ apiNewEndPoint state = do

5353 }

5454

5555-- | Create a new connection

56−apiConnect :: EndPointAddress -> MVar TransportState -> EndPointAddress -> Reliability -> IO (Either (FailedWith ConnectErrorCode) Connection)

56+apiConnect :: EndPointAddress -> MVar TransportState -> EndPointAddress -> Reliability -> IO (Either (TransportError ConnectErrorCode) Connection)

5757apiConnect myAddress state theirAddress _ = do

5858 (chan, conn) <- modifyMVar state $ \st -> do

5959 let chan = st ^. channelAt theirAddress

@@ -66,13 +66,13 @@ apiConnect myAddress state theirAddress _ = do

6666 }

6767

6868-- | Send a message over a connection

69−apiSend :: Chan Event -> ConnectionId -> MVar Bool -> [ByteString] -> IO (Either (FailedWith SendErrorCode) ())

69+apiSend :: Chan Event -> ConnectionId -> MVar Bool -> [ByteString] -> IO (Either (TransportError SendErrorCode) ())

7070apiSend chan conn connAlive msg =

7171 modifyMVar connAlive $ \alive -> do

7272 if alive

7373 then do writeChan chan (Received conn msg)

7474 return (alive, Right ())

75− else do return (alive, Left (FailedWith SendConnectionClosed "Connection closed"))

75+ else do return (alive, Left (TransportError SendFailed "Connection closed"))

7676

7777-- | Close a connection

7878apiClose :: Chan Event -> ConnectionId -> MVar Bool -> IO ()

@@ -82,7 +82,7 @@ apiClose chan conn connAlive =

8282 return False

8383

8484-- | Create a new multicast group

85−apiNewMulticastGroup :: MVar TransportState -> EndPointAddress -> IO (Either (FailedWith NewMulticastGroupErrorCode) MulticastGroup)

85+apiNewMulticastGroup :: MVar TransportState -> EndPointAddress -> IO (Either (TransportError NewMulticastGroupErrorCode) MulticastGroup)

8686apiNewMulticastGroup state ourAddress = do

8787 group <- newMVar Set.empty

8888 groupAddr <- modifyMVar state $ \st -> do

@@ -116,11 +116,11 @@ createMulticastGroup state ourAddress groupAddress group =

116116apiResolveMulticastGroup :: MVar TransportState

117117 -> EndPointAddress

118118 -> MulticastAddress

119− -> IO (Either (FailedWith ResolveMulticastGroupErrorCode) MulticastGroup)

119+ -> IO (Either (TransportError ResolveMulticastGroupErrorCode) MulticastGroup)

120120apiResolveMulticastGroup state ourAddress groupAddress = do

121121 group <- (^. (multigroups >>> DAC.mapMaybe groupAddress)) <$> readMVar state

122122 case group of

123− Nothing -> return . Left $ FailedWith ResolveMulticastGroupNotFound ("Group " ++ show groupAddress ++ " not found")

123+ Nothing -> return . Left $ TransportError ResolveMulticastGroupNotFound ("Group " ++ show groupAddress ++ " not found")

124124 Just mvar -> return . Right $ createMulticastGroup state ourAddress groupAddress mvar

125125

126126--------------------------------------------------------------------------------

network-transport-2/src/Network/Transport/TCP.hs+40−39

@@ -72,7 +72,7 @@ import Control.Concurrent.MVar ( MVar

7272 )

7373import Control.Category ((>>>))

7474import Control.Applicative ((<$>))

75−import Control.Monad (forM, forM_, when, unless)

75+import Control.Monad (forM_, when, unless)

7676import Control.Exception (IOException, SomeException, handle, throw, try, bracketOnError)

7777import Data.IORef (IORef, newIORef, writeIORef, readIORef)

7878import Data.ByteString (ByteString)

@@ -82,7 +82,7 @@ import Data.Int (Int32)

8282import Data.IntMap (IntMap)

8383import qualified Data.IntMap as IntMap (empty)

8484import Data.IntSet (IntSet)

85−import qualified Data.IntSet as IntSet (empty, insert, elems, singleton, null, delete, unions)

85+import qualified Data.IntSet as IntSet (empty, insert, elems, singleton, null, delete)

8686import Data.Map (Map)

8787import qualified Data.Map as Map (empty, elems, size)

8888import Data.Accessor (Accessor, accessor, (^.), (^=), (^:))

@@ -279,7 +279,7 @@ data RemoteEndPoint = RemoteEndPoint

279279 }

280280

281281data RemoteState =

282− RemoteEndPointInvalid (FailedWith ConnectErrorCode)

282+ RemoteEndPointInvalid (TransportError ConnectErrorCode)

283283 | RemoteEndPointValid ValidRemoteEndPointState

284284 | RemoteEndPointClosing (MVar ()) ValidRemoteEndPointState

285285 | RemoteEndPointClosed

@@ -335,6 +335,7 @@ createTransport host port = do

335335 where

336336 terminationHandler :: TCPTransport -> SomeException -> IO ()

337337 terminationHandler transport _ = do

338+ -- TODO: we currently don't make a distinction between endpoint failure and manual closure

338339 mTSt <- modifyMVar (transportState transport) $ \st -> case st of

339340 TransportValid vst -> return (TransportClosed, Just vst)

340341 TransportClosed -> return (TransportClosed, Nothing)

@@ -350,7 +351,7 @@ createTransport host port = do

350351--------------------------------------------------------------------------------

351352

352353-- | Create a new endpoint

353−apiNewEndPoint :: TCPTransport -> IO (Either (FailedWith NewEndPointErrorCode) EndPoint)

354+apiNewEndPoint :: TCPTransport -> IO (Either (TransportError NewEndPointErrorCode) EndPoint)

354355apiNewEndPoint transport = try $ do

355356 ourEndPoint <- createLocalEndPoint transport

356357 return EndPoint

@@ -362,14 +363,14 @@ apiNewEndPoint transport = try $ do

362363 , resolveMulticastGroup = return . Left . const resolveMulticastGroupError

363364 }

364365 where

365− newMulticastGroupError = FailedWith NewMulticastGroupUnsupported "TCP does not support multicast"

366− resolveMulticastGroupError = FailedWith ResolveMulticastGroupUnsupported "TCP does not support multicast"

366+ newMulticastGroupError = TransportError NewMulticastGroupUnsupported "TCP does not support multicast"

367+ resolveMulticastGroupError = TransportError ResolveMulticastGroupUnsupported "TCP does not support multicast"

367368

368369-- | Connnect to an endpoint

369370apiConnect :: LocalEndPoint -- ^ Local end point

370371 -> EndPointAddress -- ^ Remote address

371372 -> Reliability -- ^ Reliability (ignored)

372− -> IO (Either (FailedWith ConnectErrorCode) Connection)

373+ -> IO (Either (TransportError ConnectErrorCode) Connection)

373374apiConnect ourEndPoint theirAddress _ | localAddress ourEndPoint == theirAddress =

374375 connectToSelf ourEndPoint

375376apiConnect ourEndPoint theirAddress _ = try $ do

@@ -413,23 +414,23 @@ apiClose theirEndPoint connId connAlive = void . tryIO $ do

413414--

414415-- RELY: The remote endpoint must be in state 'RemoteEndPointValid' or 'RemoteEndPointClosed'

415416-- GUARANTEE: The state of the remote endpoint will not be changed.

416−apiSend :: RemoteEndPoint -> ConnectionId -> IORef Bool -> [ByteString] -> IO (Either (FailedWith SendErrorCode) ())

417+apiSend :: RemoteEndPoint -> ConnectionId -> IORef Bool -> [ByteString] -> IO (Either (TransportError SendErrorCode) ())

417418apiSend theirEndPoint connId connAlive payload = do

418419 withMVar (remoteState theirEndPoint) $ \st -> case st of

419420 RemoteEndPointValid vst -> do

420421 alive <- readIORef connAlive

421422 try $ if alive

422423 then mapExceptionIO sendFailed $ sendOn vst (encodeInt32 connId : prependLength payload)

423− else throw $ FailedWith SendConnectionClosed "Connection closed"

424+ else throw $ TransportError SendFailed "Connection closed"

424425 RemoteEndPointClosed -> do

425− return (Left $ FailedWith SendConnectionClosed "Endpoint closed")

426+ return (Left $ TransportError SendFailed "Endpoint closed")

426427 RemoteEndPointClosing _ _ ->

427428 error "apiSend RELY violation"

428429 RemoteEndPointInvalid _ ->

429430 error "apiSend RELY violation"

430431 where

431− sendFailed :: IOException -> FailedWith SendErrorCode

432− sendFailed = FailedWith SendFailed . show

432+ sendFailed :: IOException -> TransportError SendErrorCode

433+ sendFailed = TransportError SendFailed . show

433434

434435-- | Force-close the endpoint

435436apiCloseEndPoint :: TCPTransport -> LocalEndPoint -> IO ()

@@ -448,37 +449,37 @@ apiCloseEndPoint transport ourEndPoint = do

448449 return ()

449450 Just vst -> do

450451 -- Close all endpoints and kill all threads

451− incoming <- IntSet.elems . IntSet.unions <$> (forM (Map.elems $ vst ^. localConnections) $ tryCloseRemoteSocket)

452+ forM_ (Map.elems $ vst ^. localConnections) $ tryCloseRemoteSocket

452453 forM_ (vst ^. internalThreads) killThread

453454 -- We send a single message to the endpoint that it is closed. Subsequent

454455 -- calls will block. We could change this so that all subsequent calls to

455456 -- receive return an error, but this would mean checking for some state on

456457 -- every call to receive, which is an unnecessary overhead.

457− writeChan (localChannel ourEndPoint) (ErrorEvent $ ErrorEventEndPointClosed incoming)

458+ writeChan (localChannel ourEndPoint) EndPointClosed

458459 where

459460 -- Close the remote socket and return the set of all incoming connections

460− tryCloseRemoteSocket :: RemoteEndPoint -> IO IntSet

461+ tryCloseRemoteSocket :: RemoteEndPoint -> IO ()

461462 tryCloseRemoteSocket theirEndPoint = do

462463 -- We make an attempt to close the connection nicely (by sending a CloseSocket first)

463− modifyMVar (remoteState theirEndPoint) $ \st ->

464+ modifyMVar_ (remoteState theirEndPoint) $ \st ->

464465 case st of

465466 RemoteEndPointInvalid _ ->

466− return (st, IntSet.empty)

467+ return st

467468 RemoteEndPointValid conn -> do

468469 -- Try to send a CloseSocket request

469470 tryIO $ sendOn conn [encodeInt32 CloseSocket]

470471 -- .. but even if it fails, close the socket anyway

471472 -- (hence, two separate calls to tryIO)

472473 tryIO $ N.sClose (remoteSocket conn)

473− return (RemoteEndPointClosed, conn ^. remoteIncoming)

474+ return RemoteEndPointClosed

474475 RemoteEndPointClosing _ conn -> do

475476 tryIO $ N.sClose (remoteSocket conn)

476− return (RemoteEndPointClosed, IntSet.empty)

477+ return RemoteEndPointClosed

477478 RemoteEndPointClosed ->

478− return (RemoteEndPointClosed, IntSet.empty)

479+ return RemoteEndPointClosed

479480

480481-- | Special case of 'apiConnect': connect an endpoint to itself

481−connectToSelf :: LocalEndPoint -> IO (Either (FailedWith ConnectErrorCode) Connection)

482+connectToSelf :: LocalEndPoint -> IO (Either (TransportError ConnectErrorCode) Connection)

482483connectToSelf ourEndPoint = do

483484 -- Here connAlive must an MVar because it is not protected by another lock

484485 connAlive <- newMVar True

@@ -492,7 +493,7 @@ connectToSelf ourEndPoint = do

492493 ourChan :: Chan Event

493494 ourChan = localChannel ourEndPoint

494495

495− selfSend :: MVar Bool -> ConnectionId -> [ByteString] -> IO (Either (FailedWith SendErrorCode) ())

496+ selfSend :: MVar Bool -> ConnectionId -> [ByteString] -> IO (Either (TransportError SendErrorCode) ())

496497 selfSend connAlive connId msg = do

497498 modifyMVar connAlive $ \alive ->

498499 if alive

@@ -500,7 +501,7 @@ connectToSelf ourEndPoint = do

500501 writeChan ourChan (Received connId msg)

501502 return (alive, Right ())

502503 else

503− return (alive, Left (FailedWith SendConnectionClosed "Connection closed"))

504+ return (alive, Left (TransportError SendFailed "Connection closed"))

504505

505506 selfClose :: MVar Bool -> ConnectionId -> IO ()

506507 selfClose connAlive connId = do

@@ -514,7 +515,7 @@ connectToSelf ourEndPoint = do

514515

515516-- | Create a new local endpoint

516517--

517−-- May throw a FailedWith NewEndPointErrorCode exception if the transport is closed.

518+-- May throw a TransportError NewEndPointErrorCode exception if the transport is closed.

518519createLocalEndPoint :: TCPTransport -> IO LocalEndPoint

519520createLocalEndPoint transport = do

520521 chan <- newChan

@@ -535,7 +536,7 @@ createLocalEndPoint transport = do

535536 }

536537 return (TransportValid . (localEndPointAt addr ^= Just localEndPoint) $ vst, localEndPoint)

537538 TransportClosed ->

538− throw (FailedWith NewEndPointTransportFailure "Transport closed")

539+ throw (TransportError NewEndPointFailed "Transport closed")

539540

540541-- | Request a connection to a remote endpoint

541542--

@@ -543,7 +544,7 @@ createLocalEndPoint transport = do

543544-- the remote endpoint was in 'RemoteEndPointClosing' state then we will

544545-- additionally block until that is resolved.

545546--

546−-- May throw a FailedWith ConnectErrorCode exception.

547+-- May throw a TransportError ConnectErrorCode exception.

547548requestConnectionTo :: LocalEndPoint

548549 -> EndPointAddress

549550 -> IO (RemoteEndPoint, ConnectionId)

@@ -599,7 +600,7 @@ requestConnectionTo ourEndPoint theirAddress = go

599600 modifyMVar_ theirState $ \(RemoteEndPointValid ep) ->

600601 return (RemoteEndPointValid . (remoteOutgoing ^: (+ 1)) $ ep)

601602 -- TODO: should we call closeIfUnused here?

602− throw $ FailedWith ConnectFailed (show err)

603+ throw $ TransportError ConnectFailed (show err)

603604

604605 -- Do the actual connection request. This blocks until the remote

605606 -- endpoint replies (but note that we don't hold any locks at this

@@ -617,7 +618,7 @@ requestConnectionTo ourEndPoint theirAddress = go

617618 findTheirEndPoint = do

618619 (theirEndPoint, isNew) <- modifyMVar ourState $ \st -> case st of

619620 LocalEndPointClosed ->

620− throw (FailedWith ConnectFailed "Local endpoint closed")

621+ throw (TransportError ConnectFailed "Local endpoint closed")

621622 LocalEndPointValid vst ->

622623 case vst ^. localConnectionTo theirAddress of

623624 Just theirEndPoint ->

@@ -674,21 +675,21 @@ setupRemoteEndPoint (ourEndPoint, theirEndPoint) = do

674675 putMVar theirState (RemoteEndPointInvalid err)

675676 where

676677 theirState = remoteState theirEndPoint

677− invalidAddress = FailedWith ConnectInvalidAddress

678+ invalidAddress = TransportError ConnectNotFound

678679

679680-- | Establish a connection to a remote endpoint

680681socketToEndPoint :: EndPointAddress -- ^ Our address

681682 -> EndPointAddress -- ^ Their address

682− -> IO (Either (FailedWith ConnectErrorCode) (N.Socket, ConnectionRequestResponse))

683+ -> IO (Either (TransportError ConnectErrorCode) (N.Socket, ConnectionRequestResponse))

683684socketToEndPoint (EndPointAddress ourAddress) theirAddress = try $ do

684685 (host, port, theirEndPointId) <- case decodeEndPointAddress theirAddress of

685− Nothing -> throw (invalidAddress . userError $ "Could not parse")

686+ Nothing -> throw (failed . userError $ "Could not parse")

686687 Just dec -> return dec

687688 addr:_ <- mapExceptionIO invalidAddress $ N.getAddrInfo Nothing (Just host) (Just port)

688689 bracketOnError (createSocket addr) N.sClose $ \sock -> do

690+ mapExceptionIO failed $ N.setSocketOption sock N.ReuseAddr 1

691+ mapExceptionIO invalidAddress $ N.connect sock (N.addrAddress addr)

689692 response <- mapExceptionIO failed $ do

690− N.setSocketOption sock N.ReuseAddr 1

691− N.connect sock (N.addrAddress addr)

692693 sendMany sock (encodeInt32 theirEndPointId : prependLength [ourAddress])

693694 recvInt32 sock

694695 case tryToEnum response of

@@ -701,10 +702,10 @@ socketToEndPoint (EndPointAddress ourAddress) theirAddress = try $ do

701702 -- putStrLn $ "Created client socket " ++ show sock

702703 return sock

703704

704− invalidAddress, insufficientResources, failed :: IOException -> FailedWith ConnectErrorCode

705− invalidAddress = FailedWith ConnectInvalidAddress . show

706− insufficientResources = FailedWith ConnectInsufficientResources . show

707− failed = FailedWith ConnectFailed . show

705+ invalidAddress, insufficientResources, failed :: IOException -> TransportError ConnectErrorCode

706+ invalidAddress = TransportError ConnectNotFound . show

707+ insufficientResources = TransportError ConnectInsufficientResources . show

708+ failed = TransportError ConnectFailed . show

708709

709710-- | Remove reference to a remote endpoint from a local endpoint

710711--

@@ -1049,7 +1050,7 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do

10491050

10501051 -- Deal with a premature exit

10511052 prematureExit :: N.Socket -> IOException -> IO ()

1052− prematureExit sock _ = do

1053+ prematureExit sock err = do

10531054 N.sClose sock

10541055 removeRemoteEndPoint (ourEndPoint, theirEndPoint)

10551056 mUnclosedConnections <- modifyMVar theirState $ \st ->

@@ -1069,7 +1070,7 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do

10691070 Nothing ->

10701071 return ()

10711072 Just unclosedConnections -> writeChan ourChannel . ErrorEvent $

1072− ErrorEventConnectionLost (remoteAddress theirEndPoint) (IntSet.elems unclosedConnections)

1073+ TransportError (EventConnectionLost (remoteAddress theirEndPoint) (IntSet.elems unclosedConnections)) (show err)

10731074

10741075-- | Get the next connection ID

10751076--

network-transport-2/tests/TestAuxiliary.hs+1−1

@@ -75,7 +75,7 @@ instance Traceable Connection where

7575instance Traceable Event where

7676 trace = traceShow

7777

78−instance Show err => Traceable (FailedWith err) where

78+instance Show err => Traceable (TransportError err) where

7979 trace = traceShow

8080

8181instance Traceable EndPointAddress where

network-transport-2/tests/TestTCP.hs+30−14

@@ -68,7 +68,7 @@ testEarlyDisconnect nextPort = do

6868 ConnectionOpened cid _ addr <- receive endpoint

6969 True <- return $ addr == theirAddr

7070

71− ErrorEvent (ErrorEventConnectionLost addr' [cid']) <- receive endpoint

71+ ErrorEvent (TransportError (EventConnectionLost addr' [cid']) _) <- receive endpoint

7272 True <- return $ addr' == theirAddr && cid' == cid

7373

7474 return ()

@@ -84,13 +84,20 @@ testEarlyDisconnect nextPort = do

8484 -- closes the socket

8585 do

8686 Right () <- send conn ["ping"]

87− ConnectionOpened cid _ addr <- receive endpoint ; True <- return $ addr == theirAddr

88− Received cid' ["pong"] <- receive endpoint ; True <- return $ cid == cid'

89− ErrorEvent (ErrorEventConnectionLost addr' [cid'']) <- receive endpoint ; True <- return $ addr' == theirAddr && cid'' == cid

87+

88+ ConnectionOpened cid _ addr <- receive endpoint

89+ True <- return $ addr == theirAddr

90+

91+ Received cid' ["pong"] <- receive endpoint

92+ True <- return $ cid == cid'

93+

94+ ErrorEvent (TransportError (EventConnectionLost addr' [cid'']) _) <- receive endpoint

95+ True <- return $ addr' == theirAddr && cid'' == cid

96+

9097 return ()

9198

9299 -- TEST 4: A subsequent send on an already-open connection will now break

93− Left (FailedWith SendConnectionClosed _) <- send conn ["ping2"]

100+ Left (TransportError SendFailed _) <- send conn ["ping2"]

94101

95102 -- *Pfew*

96103 putMVar serverDone ()

@@ -185,14 +192,23 @@ testEarlyCloseSocket nextPort = do

185192 -- the socket gets closed

186193 do

187194 Right () <- send conn ["ping"]

188− ConnectionOpened cid _ addr <- receive endpoint ; True <- return $ addr == theirAddr

189− Received cid' ["pong"] <- receive endpoint ; True <- return $ cid' == cid

190− ConnectionClosed cid'' <- receive endpoint ; True <- return $ cid'' == cid

191− ErrorEvent (ErrorEventConnectionLost addr' []) <- receive endpoint ; True <- return $ addr' == theirAddr

195+

196+ ConnectionOpened cid _ addr <- receive endpoint

197+ True <- return $ addr == theirAddr

198+

199+ Received cid' ["pong"] <- receive endpoint

200+ True <- return $ cid' == cid

201+

202+ ConnectionClosed cid'' <- receive endpoint

203+ True <- return $ cid'' == cid

204+

205+ ErrorEvent (TransportError (EventConnectionLost addr' []) _) <- receive endpoint

206+ True <- return $ addr' == theirAddr

207+

192208 return ()

193209

194210 -- TEST 4: A subsequent send on an already-open connection will now break

195− Left (FailedWith SendConnectionClosed _) <- send conn ["ping2"]

211+ Left (TransportError SendFailed _) <- send conn ["ping2"]

196212

197213 -- *Pfew*

198214 putMVar serverDone ()

@@ -258,19 +274,19 @@ testInvalidConnect nextPort = do

258274 Right endpoint <- newEndPoint transport

259275

260276 -- Syntax error in the endpoint address

261− Left (FailedWith ConnectInvalidAddress _) <-

277+ Left (TransportError ConnectFailed _) <-

262278 connect endpoint (EndPointAddress "InvalidAddress") ReliableOrdered

263279

264280 -- Syntax connect, but invalid hostname (TCP address lookup failure)

265− Left (FailedWith ConnectInvalidAddress _) <-

281+ Left (TransportError ConnectNotFound _) <-

266282 connect endpoint (encodeEndPointAddress "invalidHost" "port" 0) ReliableOrdered

267283

268284 -- TCP address correct, but nobody home at that address

269− Left (FailedWith ConnectFailed _) <-

285+ Left (TransportError ConnectNotFound _) <-

270286 connect endpoint (encodeEndPointAddress "127.0.0.1" "9000" 0) ReliableOrdered

271287

272288 -- Valid TCP address but invalid endpoint number

273− Left (FailedWith ConnectInvalidAddress _) <-

289+ Left (TransportError ConnectNotFound _) <-

274290 connect endpoint (encodeEndPointAddress "127.0.0.1" port 1) ReliableOrdered

275291

276292 return ()

network-transport-2/tests/TestTransport.hs+22−17

@@ -5,6 +5,7 @@ import Prelude hiding (catch, (>>=), (>>), return, fail)

55import TestAuxiliary (forkTry, runTests)

66import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar, readMVar)

77import Control.Monad (replicateM, replicateM_, when, guard, forM_)

8+import Control.Monad.Error ()

89import Network.Transport

910import Network.Transport.Internal (tlog)

1011import Network.Transport.Util (spawn)

@@ -40,6 +41,8 @@ echoServer endpoint = do

4041 go cs

4142 ErrorEvent _ ->

4243 fail (show event)

44+ EndPointClosed ->

45+ return ()

4346

4447-- | Ping client used in a few tests

4548ping :: EndPoint -> EndPointAddress -> Int -> ByteString -> IO ()

@@ -286,6 +289,8 @@ collect endPoint numEvents = go numEvents Map.empty Map.empty

286289 fail "Unexpected multicast"

287290 ErrorEvent _ ->

288291 fail "Unexpected error"

292+ EndPointClosed ->

293+ fail "Unexpected endpoint closure"

289294

290295-- | Open connection, close it, then reopen it

291296-- (In the TCP transport this means the socket will be closed, then reopened)

@@ -384,12 +389,12 @@ testSendAfterClose transport _ = do

384389 -- connection (i.e., on a closed connection while there is still another

385390 -- connection open)

386391 close conn2

387− Left (FailedWith SendConnectionClosed _) <- send conn2 ["ping2"]

392+ Left (TransportError SendFailed _) <- send conn2 ["ping2"]

388393

389394 -- Now close the first connection, and output on it (i.e., output while

390395 -- there are no lightweight connection at all anymore)

391396 close conn1

392− Left (FailedWith SendConnectionClosed _) <- send conn2 ["ping2"]

397+ Left (TransportError SendFailed _) <- send conn2 ["ping2"]

393398

394399 putMVar clientDone ()

395400

@@ -545,9 +550,9 @@ testCloseEndPoint transport _ = do

545550 send conn ["pong"]

546551

547552 ConnectionClosed cid'' <- receive endpoint ; True <- return $ cid == cid''

548− ErrorEvent (ErrorEventConnectionLost addr' []) <- receive endpoint ; True <- return $ addr' == theirAddr

553+ ErrorEvent (TransportError (EventConnectionLost addr' []) _) <- receive endpoint ; True <- return $ addr' == theirAddr

549554

550− Left (FailedWith SendConnectionClosed _) <- send conn ["pong2"]

555+ Left (TransportError SendFailed _) <- send conn ["pong2"]

551556

552557 return ()

553558

@@ -565,7 +570,7 @@ testCloseEndPoint transport _ = do

565570 -- Connect to the server, then close the endpoint without disconnecting explicitly

566571 Right _ <- connect endpoint theirAddr ReliableOrdered

567572 closeEndPoint endpoint

568− ErrorEvent (ErrorEventEndPointClosed []) <- receive endpoint

573+ EndPointClosed <- receive endpoint

569574 return ()

570575

571576 -- Second test: close endpoint with one outgoing and one incoming connection

@@ -582,16 +587,16 @@ testCloseEndPoint transport _ = do

582587

583588 -- Close the endpoint

584589 closeEndPoint endpoint

585− ErrorEvent (ErrorEventEndPointClosed [cid'']) <- receive endpoint; True <- return $ cid == cid''

590+ EndPointClosed <- receive endpoint

586591

587592 -- Attempt to send should fail with connection closed

588− Left (FailedWith SendConnectionClosed _) <- send conn ["ping2"]

593+ Left (TransportError SendFailed _) <- send conn ["ping2"]

589594

590595 -- An attempt to close the already closed connection should just return

591596 () <- close conn

592597

593598 -- And so should an attempt to connect

594− Left (FailedWith ConnectFailed _) <- connect endpoint theirAddr ReliableOrdered

599+ Left (TransportError ConnectFailed _) <- connect endpoint theirAddr ReliableOrdered

595600

596601 return ()

597602

@@ -632,11 +637,11 @@ testCloseTransport newTransport = do

632637 -- Client now closes down its transport. We should receive connection closed messages

633638 -- TODO: this assumes a certain ordering on the messages we receive; that's not guaranteed

634639 ConnectionClosed cid2'' <- receive endpoint ; True <- return $ cid2'' == cid2

635− ErrorEvent (ErrorEventConnectionLost addr'' []) <- receive endpoint ; True <- return $ addr'' == theirAddr2

640+ ErrorEvent (TransportError (EventConnectionLost addr'' []) _) <- receive endpoint ; True <- return $ addr'' == theirAddr2

636641 ConnectionClosed cid1' <- receive endpoint ; True <- return $ cid1' == cid1

637642

638643 -- An attempt to send to the endpoint should now fail

639− Left (FailedWith SendConnectionClosed _) <- send conn ["pong2"]

644+ Left (TransportError SendFailed _) <- send conn ["pong2"]

640645

641646 putMVar serverDone ()

642647

@@ -666,22 +671,22 @@ testCloseTransport newTransport = do

666671 -- Now shut down the entire transport

667672 closeTransport transport

668673

669− -- Both endpoints should report an error

670− ErrorEvent (ErrorEventEndPointClosed []) <- receive endpoint1

671− ErrorEvent (ErrorEventEndPointClosed [cid'']) <- receive endpoint2; True <- return $ cid == cid''

674+ -- Both endpoints should report that they have been closed

675+ EndPointClosed <- receive endpoint1

676+ EndPointClosed <- receive endpoint2

672677

673678 -- Attempt to send should fail with connection closed

674− Left (FailedWith SendConnectionClosed _) <- send conn ["ping2"]

679+ Left (TransportError SendFailed _) <- send conn ["ping2"]

675680

676681 -- An attempt to close the already closed connection should just return

677682 () <- close conn

678683

679684 -- And so should an attempt to connect on either endpoint

680− Left (FailedWith ConnectFailed _) <- connect endpoint1 theirAddr ReliableOrdered

681− Left (FailedWith ConnectFailed _) <- connect endpoint2 theirAddr ReliableOrdered

685+ Left (TransportError ConnectFailed _) <- connect endpoint1 theirAddr ReliableOrdered

686+ Left (TransportError ConnectFailed _) <- connect endpoint2 theirAddr ReliableOrdered

682687

683688 -- And finally, so should an attempt to create a new endpoint

684− Left (FailedWith NewEndPointTransportFailure _) <- newEndPoint transport

689+ Left (TransportError NewEndPointFailed _) <- newEndPoint transport

685690

686691 putMVar clientDone ()

687692