f5c847b · distributed-process

git.iko.soy/distributed-process

on master help sign in

More consistent errors

f5c847bEdsko de Vries14 years ago

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

compare with master

unifiedsplit

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

10 , EndPointAddress(..)

11 , MulticastAddress(..)

12 -- * Error codes

13− , FailedWith(..)

13+ , TransportError(..)

14 , NewEndPointErrorCode(..)

15 , ConnectErrorCode(..)

16 , NewMulticastGroupErrorCode(..)

17 , ResolveMulticastGroupErrorCode(..)

18 , SendErrorCode(..)

19− , ErrorEventInfo(..)

19+ , EventErrorCode(..)

20 ) where

22import Data.ByteString (ByteString)

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

24import Control.Exception (Exception)

23import Control.Exception (Exception)

25import Data.Typeable (Typeable)

24import Data.Typeable (Typeable)

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

32-- @Network.Transport.*@ packages.

31-- @Network.Transport.*@ packages.

33data Transport = Transport {

32data Transport = Transport {

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

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

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

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

36 -- | Shutdown the transport completely

35 -- | Shutdown the transport completely

37 , closeTransport :: IO ()

36 , closeTransport :: IO ()

38 }

37 }

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

44 -- | EndPointAddress of the endpoint.

43 -- | EndPointAddress of the endpoint.

45 , address :: EndPointAddress

44 , address :: EndPointAddress

46 -- | Create a new lightweight connection.

45 -- | Create a new lightweight connection.

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

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

48 -- | Create a new multicast group.

47 -- | Create a new multicast group.

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

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

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

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

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

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

52 -- | Close the endpoint

51 -- | Close the endpoint

53 , closeEndPoint :: IO ()

52 , closeEndPoint :: IO ()

54 }

53 }

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

56-- | Lightweight connection to an endpoint.

55-- | Lightweight connection to an endpoint.

57data Connection = Connection {

56data Connection = Connection {

58 -- | Send a message on this connection.

57 -- | Send a message on this connection.

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

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

60 -- | Close the connection.

59 -- | Close the connection.

61 , close :: IO ()

60 , close :: IO ()

62 }

61 }

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

71 | ConnectionOpened ConnectionId Reliability EndPointAddress

70 | ConnectionOpened ConnectionId Reliability EndPointAddress

72 -- | Received multicast

71 -- | Received multicast

73 | ReceivedMulticast MulticastAddress [ByteString]

72 | ReceivedMulticast MulticastAddress [ByteString]

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

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

75− | ErrorEvent ErrorEventInfo

74+ | EndPointClosed

75+ -- | An error occurred

76+ | ErrorEvent (TransportError EventErrorCode)

76 deriving Show

77 deriving Show

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

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

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

115-- Error codes --

116-- Error codes --

116--------------------------------------------------------------------------------

117--------------------------------------------------------------------------------

117

118

118−data FailedWith error = FailedWith error String

119+data TransportError error = TransportError error String

119 deriving (Show, Typeable)

120 deriving (Show, Typeable)

120

121

121−instance Error (FailedWith error) where

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

122− strMsg = FailedWith undefined

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

124+-- exceptions.

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

123

126

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

128data 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

130 deriving (Show, Typeable)

135 deriving (Show, Typeable)

131

136

132-- | Connection failure

137-- | Connection failure

133data ConnectErrorCode =

138data ConnectErrorCode =

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

139+ -- | Could not resolve the address

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

141+ ConnectNotFound

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

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

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

144+ | ConnectInsufficientResources

136− | ConnectFailed -- ^ Failed for other reasons

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

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

147+ | ConnectFailed

137 deriving (Show, Typeable)

148 deriving (Show, Typeable)

138

149

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

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

140data NewMulticastGroupErrorCode =

151data NewMulticastGroupErrorCode =

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

141− NewMulticastGroupUnsupported

159+ | NewMulticastGroupUnsupported

142 deriving (Show, Typeable)

160 deriving (Show, Typeable)

143

161

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

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

145data ResolveMulticastGroupErrorCode =

163data ResolveMulticastGroupErrorCode =

164+ -- | Multicast group not found

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

146 ResolveMulticastGroupNotFound

166 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

147 | ResolveMulticastGroupUnsupported

171 | ResolveMulticastGroupUnsupported

148 deriving (Show, Typeable)

172 deriving (Show, Typeable)

149

173

150-- | Failure during sending a message

174-- | Failure during sending a message

151data SendErrorCode =

175data SendErrorCode =

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

176+ -- | Could not send this message

177+ -- (but another attempt might succeed)

178+ SendUnreachable

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

179+ -- | Send failed for some other reason

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

181+ | SendFailed

154 deriving (Show, Typeable)

182 deriving (Show, Typeable)

155

183

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

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

157−data ErrorEventInfo =

185+data EventErrorCode =

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

186+ -- | Failure of the entire endpoint

159− ErrorEventEndPointClosed [ConnectionId]

187+ EventEndPointFailed

160 -- | Transport-wide fatal error

188 -- | Transport-wide fatal error

161− | ErrorEventTransportFailure

189+ | EventTransportFailed

162 -- | Connection to a remote endpoint was lost

190 -- | Connection to a remote endpoint was lost

163− | ErrorEventConnectionLost EndPointAddress [ConnectionId]

191+ | EventConnectionLost EndPointAddress [ConnectionId]

164 deriving Show

192 deriving Show

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

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

38 }

40-- | Create a new end point

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

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

42apiNewEndPoint state = do

43 chan <- newChan

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

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

53 }

55-- | 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)

57apiConnect myAddress state theirAddress _ = do

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

59 let chan = st ^. channelAt theirAddress

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

66 }

68-- | 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) ())

70apiSend chan conn connAlive msg =

71 modifyMVar connAlive $ \alive -> do

72 if alive

73 then do writeChan chan (Received conn msg)

74 return (alive, Right ())

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

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

77-- | Close a connection

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

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

82 return False

84-- | 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)

86apiNewMulticastGroup state ourAddress = do

87 group <- newMVar Set.empty

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

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

116apiResolveMulticastGroup :: MVar TransportState

117 -> EndPointAddress

118 -> MulticastAddress

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

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

120apiResolveMulticastGroup state ourAddress groupAddress = do

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

122 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")

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

125

126--------------------------------------------------------------------------------

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

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

72 )

73import Control.Category ((>>>))

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

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

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

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

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

78import Data.ByteString (ByteString)

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

82import Data.IntMap (IntMap)

83import qualified Data.IntMap as IntMap (empty)

84import 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)

86import Data.Map (Map)

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

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

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

279 }

280

281data RemoteState =

282− RemoteEndPointInvalid (FailedWith ConnectErrorCode)

282+ RemoteEndPointInvalid (TransportError ConnectErrorCode)

283 | RemoteEndPointValid ValidRemoteEndPointState

284 | RemoteEndPointClosing (MVar ()) ValidRemoteEndPointState

285 | RemoteEndPointClosed

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

335 where

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

337 terminationHandler transport _ = do

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

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

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

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

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

340 TransportClosed -> return (TransportClosed, Nothing)

341 TransportClosed -> return (TransportClosed, Nothing)

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

350--------------------------------------------------------------------------------

351--------------------------------------------------------------------------------

351

352

352-- | Create a new endpoint

353-- | Create a new endpoint

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

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

354apiNewEndPoint transport = try $ do

355apiNewEndPoint transport = try $ do

355 ourEndPoint <- createLocalEndPoint transport

356 ourEndPoint <- createLocalEndPoint transport

356 return EndPoint

357 return EndPoint

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

362 , resolveMulticastGroup = return . Left . const resolveMulticastGroupError

363 , resolveMulticastGroup = return . Left . const resolveMulticastGroupError

363 }

364 }

364 where

365 where

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

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

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

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

367

368

368-- | Connnect to an endpoint

369-- | Connnect to an endpoint

369apiConnect :: LocalEndPoint -- ^ Local end point

370apiConnect :: LocalEndPoint -- ^ Local end point

370 -> EndPointAddress -- ^ Remote address

371 -> EndPointAddress -- ^ Remote address

371 -> Reliability -- ^ Reliability (ignored)

372 -> Reliability -- ^ Reliability (ignored)

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

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

373apiConnect ourEndPoint theirAddress _ | localAddress ourEndPoint == theirAddress =

374apiConnect ourEndPoint theirAddress _ | localAddress ourEndPoint == theirAddress =

374 connectToSelf ourEndPoint

375 connectToSelf ourEndPoint

375apiConnect ourEndPoint theirAddress _ = try $ do

376apiConnect ourEndPoint theirAddress _ = try $ do

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

413--

414--

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

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

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

416-- 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) ())

417apiSend theirEndPoint connId connAlive payload = do

418apiSend theirEndPoint connId connAlive payload = do

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

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

419 RemoteEndPointValid vst -> do

420 RemoteEndPointValid vst -> do

420 alive <- readIORef connAlive

421 alive <- readIORef connAlive

421 try $ if alive

422 try $ if alive

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

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

423− else throw $ FailedWith SendConnectionClosed "Connection closed"

424+ else throw $ TransportError SendFailed "Connection closed"

424 RemoteEndPointClosed -> do

425 RemoteEndPointClosed -> do

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

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

426 RemoteEndPointClosing _ _ ->

427 RemoteEndPointClosing _ _ ->

427 error "apiSend RELY violation"

428 error "apiSend RELY violation"

428 RemoteEndPointInvalid _ ->

429 RemoteEndPointInvalid _ ->

429 error "apiSend RELY violation"

430 error "apiSend RELY violation"

430 where

431 where

431− sendFailed :: IOException -> FailedWith SendErrorCode

432+ sendFailed :: IOException -> TransportError SendErrorCode

432− sendFailed = FailedWith SendFailed . show

433+ sendFailed = TransportError SendFailed . show

433

434

434-- | Force-close the endpoint

435-- | Force-close the endpoint

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

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

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

448 return ()

449 return ()

449 Just vst -> do

450 Just vst -> do

450 -- Close all endpoints and kill all threads

451 -- 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

452 forM_ (vst ^. internalThreads) killThread

453 forM_ (vst ^. internalThreads) killThread

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

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

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

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

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

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

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

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

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

458+ writeChan (localChannel ourEndPoint) EndPointClosed

458 where

459 where

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

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

460− tryCloseRemoteSocket :: RemoteEndPoint -> IO IntSet

461+ tryCloseRemoteSocket :: RemoteEndPoint -> IO ()

461 tryCloseRemoteSocket theirEndPoint = do

462 tryCloseRemoteSocket theirEndPoint = do

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

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

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

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

464 case st of

465 case st of

465 RemoteEndPointInvalid _ ->

466 RemoteEndPointInvalid _ ->

466− return (st, IntSet.empty)

467+ return st

467 RemoteEndPointValid conn -> do

468 RemoteEndPointValid conn -> do

468 -- Try to send a CloseSocket request

469 -- Try to send a CloseSocket request

469 tryIO $ sendOn conn [encodeInt32 CloseSocket]

470 tryIO $ sendOn conn [encodeInt32 CloseSocket]

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

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

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

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

472 tryIO $ N.sClose (remoteSocket conn)

473 tryIO $ N.sClose (remoteSocket conn)

473− return (RemoteEndPointClosed, conn ^. remoteIncoming)

474+ return RemoteEndPointClosed

474 RemoteEndPointClosing _ conn -> do

475 RemoteEndPointClosing _ conn -> do

475 tryIO $ N.sClose (remoteSocket conn)

476 tryIO $ N.sClose (remoteSocket conn)

476− return (RemoteEndPointClosed, IntSet.empty)

477+ return RemoteEndPointClosed

477 RemoteEndPointClosed ->

478 RemoteEndPointClosed ->

478− return (RemoteEndPointClosed, IntSet.empty)

479+ return RemoteEndPointClosed

479

480

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

481-- | 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)

482connectToSelf ourEndPoint = do

483connectToSelf ourEndPoint = do

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

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

484 connAlive <- newMVar True

485 connAlive <- newMVar True

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

492 ourChan :: Chan Event

493 ourChan :: Chan Event

493 ourChan = localChannel ourEndPoint

494 ourChan = localChannel ourEndPoint

494

495

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

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

496 selfSend connAlive connId msg = do

497 selfSend connAlive connId msg = do

497 modifyMVar connAlive $ \alive ->

498 modifyMVar connAlive $ \alive ->

498 if alive

499 if alive

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

500 writeChan ourChan (Received connId msg)

501 writeChan ourChan (Received connId msg)

501 return (alive, Right ())

502 return (alive, Right ())

502 else

503 else

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

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

504

505

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

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

506 selfClose connAlive connId = do

507 selfClose connAlive connId = do

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

514

515

515-- | Create a new local endpoint

516-- | Create a new local endpoint

516--

517--

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

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

518createLocalEndPoint :: TCPTransport -> IO LocalEndPoint

519createLocalEndPoint :: TCPTransport -> IO LocalEndPoint

519createLocalEndPoint transport = do

520createLocalEndPoint transport = do

520 chan <- newChan

521 chan <- newChan

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

535 }

536 }

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

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

537 TransportClosed ->

538 TransportClosed ->

538− throw (FailedWith NewEndPointTransportFailure "Transport closed")

539+ throw (TransportError NewEndPointFailed "Transport closed")

539

540

540-- | Request a connection to a remote endpoint

541-- | Request a connection to a remote endpoint

541--

542--

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

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

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

544-- additionally block until that is resolved.

545-- additionally block until that is resolved.

545--

546--

546−-- May throw a FailedWith ConnectErrorCode exception.

547+-- May throw a TransportError ConnectErrorCode exception.

547requestConnectionTo :: LocalEndPoint

548requestConnectionTo :: LocalEndPoint

548 -> EndPointAddress

549 -> EndPointAddress

549 -> IO (RemoteEndPoint, ConnectionId)

550 -> IO (RemoteEndPoint, ConnectionId)

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

599 modifyMVar_ theirState $ \(RemoteEndPointValid ep) ->

600 modifyMVar_ theirState $ \(RemoteEndPointValid ep) ->

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

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

601 -- TODO: should we call closeIfUnused here?

602 -- TODO: should we call closeIfUnused here?

602− throw $ FailedWith ConnectFailed (show err)

603+ throw $ TransportError ConnectFailed (show err)

603

604

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

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

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

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

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

617 findTheirEndPoint = do

618 findTheirEndPoint = do

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

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

619 LocalEndPointClosed ->

620 LocalEndPointClosed ->

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

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

621 LocalEndPointValid vst ->

622 LocalEndPointValid vst ->

622 case vst ^. localConnectionTo theirAddress of

623 case vst ^. localConnectionTo theirAddress of

623 Just theirEndPoint ->

624 Just theirEndPoint ->

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

674 putMVar theirState (RemoteEndPointInvalid err)

675 putMVar theirState (RemoteEndPointInvalid err)

675 where

676 where

676 theirState = remoteState theirEndPoint

677 theirState = remoteState theirEndPoint

677− invalidAddress = FailedWith ConnectInvalidAddress

678+ invalidAddress = TransportError ConnectNotFound

678

679

679-- | Establish a connection to a remote endpoint

680-- | Establish a connection to a remote endpoint

680socketToEndPoint :: EndPointAddress -- ^ Our address

681socketToEndPoint :: EndPointAddress -- ^ Our address

681 -> EndPointAddress -- ^ Their address

682 -> EndPointAddress -- ^ Their address

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

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

683socketToEndPoint (EndPointAddress ourAddress) theirAddress = try $ do

684socketToEndPoint (EndPointAddress ourAddress) theirAddress = try $ do

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

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

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

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

686 Just dec -> return dec

687 Just dec -> return dec

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

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

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

689 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)

689 response <- mapExceptionIO failed $ do

692 response <- mapExceptionIO failed $ do

690− N.setSocketOption sock N.ReuseAddr 1

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

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

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

693 recvInt32 sock

694 recvInt32 sock

694 case tryToEnum response of

695 case tryToEnum response of

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

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

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

702 return sock

703 return sock

703

704

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

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

705− invalidAddress = FailedWith ConnectInvalidAddress . show

706+ invalidAddress = TransportError ConnectNotFound . show

706− insufficientResources = FailedWith ConnectInsufficientResources . show

707+ insufficientResources = TransportError ConnectInsufficientResources . show

707− failed = FailedWith ConnectFailed . show

708+ failed = TransportError ConnectFailed . show

708

709

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

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

710--

711--

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

1049

1050

1050 -- Deal with a premature exit

1051 -- Deal with a premature exit

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

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

1052− prematureExit sock _ = do

1053+ prematureExit sock err = do

1053 N.sClose sock

1054 N.sClose sock

1054 removeRemoteEndPoint (ourEndPoint, theirEndPoint)

1055 removeRemoteEndPoint (ourEndPoint, theirEndPoint)

1055 mUnclosedConnections <- modifyMVar theirState $ \st ->

1056 mUnclosedConnections <- modifyMVar theirState $ \st ->

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

1069 Nothing ->

1070 Nothing ->

1070 return ()

1071 return ()

1071 Just unclosedConnections -> writeChan ourChannel . ErrorEvent $

1072 Just unclosedConnections -> writeChan ourChannel . ErrorEvent $

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

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

1073

1074

1074-- | Get the next connection ID

1075-- | Get the next connection ID

1075--

1076--

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

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

75instance Traceable Event where

76 trace = traceShow

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

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

79 trace = traceShow

81instance Traceable EndPointAddress where

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

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

68 ConnectionOpened cid _ addr <- receive endpoint

69 True <- return $ addr == theirAddr

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

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

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

74 return ()

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

84 -- closes the socket

85 do

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

87+

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

88+ ConnectionOpened cid _ addr <- receive endpoint

89+ True <- return $ addr == theirAddr

90+

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

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

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

93+

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

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

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

96+

90 return ()

97 return ()

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

99 -- 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"]

101

95 -- *Pfew*

102 -- *Pfew*

96 putMVar serverDone ()

103 putMVar serverDone ()

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

185 -- the socket gets closed

192 -- the socket gets closed

186 do

193 do

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

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

195+

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

196+ ConnectionOpened cid _ addr <- receive endpoint

197+ True <- return $ addr == theirAddr

198+

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

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

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

201+

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

202+ ConnectionClosed cid'' <- receive endpoint

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

204+

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

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

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

207+

192 return ()

208 return ()

193

209

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

210 -- 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"]

196

212

197 -- *Pfew*

213 -- *Pfew*

198 putMVar serverDone ()

214 putMVar serverDone ()

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

258 Right endpoint <- newEndPoint transport

274 Right endpoint <- newEndPoint transport

259

275

260 -- Syntax error in the endpoint address

276 -- Syntax error in the endpoint address

261− Left (FailedWith ConnectInvalidAddress _) <-

277+ Left (TransportError ConnectFailed _) <-

262 connect endpoint (EndPointAddress "InvalidAddress") ReliableOrdered

278 connect endpoint (EndPointAddress "InvalidAddress") ReliableOrdered

263

279

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

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

265− Left (FailedWith ConnectInvalidAddress _) <-

281+ Left (TransportError ConnectNotFound _) <-

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

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

267

283

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

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

269− Left (FailedWith ConnectFailed _) <-

285+ Left (TransportError ConnectNotFound _) <-

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

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

271

287

272 -- Valid TCP address but invalid endpoint number

288 -- Valid TCP address but invalid endpoint number

273− Left (FailedWith ConnectInvalidAddress _) <-

289+ Left (TransportError ConnectNotFound _) <-

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

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

275

291

276 return ()

292 return ()

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

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

5import TestAuxiliary (forkTry, runTests)

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

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

8+import Control.Monad.Error ()

8import Network.Transport

9import Network.Transport

9import Network.Transport.Internal (tlog)

10import Network.Transport.Internal (tlog)

10import Network.Transport.Util (spawn)

11import Network.Transport.Util (spawn)

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

40 go cs

41 go cs

41 ErrorEvent _ ->

42 ErrorEvent _ ->

42 fail (show event)

43 fail (show event)

44+ EndPointClosed ->

45+ return ()

44-- | Ping client used in a few tests

47-- | Ping client used in a few tests

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

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

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

286 fail "Unexpected multicast"

289 fail "Unexpected multicast"

287 ErrorEvent _ ->

290 ErrorEvent _ ->

288 fail "Unexpected error"

291 fail "Unexpected error"

292+ EndPointClosed ->

293+ fail "Unexpected endpoint closure"

289

294

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

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

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

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

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

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

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

385 -- connection open)

390 -- connection open)

386 close conn2

391 close conn2

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

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

388

393

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

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

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

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

391 close conn1

396 close conn1

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

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

393

398

394 putMVar clientDone ()

399 putMVar clientDone ()

395

400

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

545 send conn ["pong"]

550 send conn ["pong"]

546

551

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

552 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

549

554

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

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

551

556

552 return ()

557 return ()

553

558

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

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

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

566 Right _ <- connect endpoint theirAddr ReliableOrdered

571 Right _ <- connect endpoint theirAddr ReliableOrdered

567 closeEndPoint endpoint

572 closeEndPoint endpoint

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

573+ EndPointClosed <- receive endpoint

569 return ()

574 return ()

570

575

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

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

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

582

587

583 -- Close the endpoint

588 -- Close the endpoint

584 closeEndPoint endpoint

589 closeEndPoint endpoint

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

590+ EndPointClosed <- receive endpoint

586

591

587 -- Attempt to send should fail with connection closed

592 -- Attempt to send should fail with connection closed

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

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

589

594

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

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

591 () <- close conn

596 () <- close conn

592

597

593 -- And so should an attempt to connect

598 -- And so should an attempt to connect

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

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

595

600

596 return ()

601 return ()

597

602

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

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

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

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

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

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

639 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

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

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

637

642

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

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

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

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

640

645

641 putMVar serverDone ()

646 putMVar serverDone ()

642

647

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

666 -- Now shut down the entire transport

671 -- Now shut down the entire transport

667 closeTransport transport

672 closeTransport transport

668

673

669− -- Both endpoints should report an error

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

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

675+ EndPointClosed <- receive endpoint1

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

676+ EndPointClosed <- receive endpoint2

672

677

673 -- Attempt to send should fail with connection closed

678 -- Attempt to send should fail with connection closed

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

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

675

680

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

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

677 () <- close conn

682 () <- close conn

678

683

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

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

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

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

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

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

682

687

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

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

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

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

685

690

686 putMVar clientDone ()

691 putMVar clientDone ()

687

692