8f8f8cb · distributed-process

git.iko.soy/distributed-process

on master help sign in

Use throwIO instead of throw

8f8f8cbEdsko de Vries14 years ago

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

compare with master

unifiedsplit

@@ -6,7 +6,7 @@ import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)

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

7import Control.Category ((>>>))

8import Control.Concurrent.MVar (MVar, newMVar, modifyMVar, modifyMVar_, readMVar)

9−import Control.Exception (throw)

9+import Control.Exception (throwIO)

10import Control.Monad (forM_, when)

11import Data.Map (Map)

12import qualified Data.Map as Map (empty, insert, size, delete, findWithDefault)

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

34 , _multigroups = Map.empty

35 }

36 return Transport { newEndPoint = apiNewEndPoint state

37− , closeTransport = throw (userError "closeEndPoint not implemented")

37+ , closeTransport = throwIO (userError "closeEndPoint not implemented")

38 }

40-- | Create a new end point

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

47 return . Right $ EndPoint { receive = readChan chan

48 , address = addr

49 , connect = apiConnect addr state

50− , closeEndPoint = throw (userError "closeEndPoint not implemented")

50+ , closeEndPoint = throwIO (userError "closeEndPoint not implemented")

51 , newMulticastGroup = apiNewMulticastGroup state addr

52 , resolveMulticastGroup = apiResolveMulticastGroup state addr

53 }

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

@@ -22,7 +22,7 @@ import Data.ByteString (ByteString)

22import qualified Data.ByteString as BS (length)

23import qualified Data.ByteString.Internal as BSI (unsafeCreate, toForeignPtr, inlinePerformIO)

24import Control.Monad.IO.Class (MonadIO, liftIO)

25−import Control.Exception (IOException, Exception, catch, try, throw)

25+import Control.Exception (IOException, Exception, catch, try, throwIO)

26--import Control.Concurrent (myThreadId)

28foreign import ccall unsafe "htonl" htonl :: CInt -> CInt

@@ -66,7 +66,7 @@ prependLength bss = encodeInt32 (sum . map BS.length $ bss) : bss

67-- | Translate exceptions that arise in IO computations

68mapExceptionIO :: (Exception e1, Exception e2) => (e1 -> e2) -> IO a -> IO a

69−mapExceptionIO f p = catch p (throw . f)

69+mapExceptionIO f p = catch p (throwIO . f)

71-- | Like 'try', but lifted and specialized to IOExceptions

72tryIO :: MonadIO m => IO a -> m (Either IOException a)

network-transport/src/Network/Transport/Internal/TCP.hs+4−4

@@ -27,7 +27,7 @@ import qualified Network.Socket as N ( HostName

27import qualified Network.Socket.ByteString as NBS (recv)

28import Control.Concurrent (ThreadId, forkIOWithUnmask)

29import Control.Monad (liftM, forever)

30−import Control.Exception (SomeException, catch, bracketOnError, throw, mask_)

30+import Control.Exception (SomeException, catch, bracketOnError, throwIO, mask_)

31import Data.ByteString (ByteString)

32import qualified Data.ByteString as BS (length, concat, null)

33import Data.Int (Int32)

@@ -84,7 +84,7 @@ recvInt32 :: Num a => N.Socket -> IO a

84recvInt32 sock = do

85 mi <- liftM (decodeInt32 . BS.concat) $ recvExact sock 4

86 case mi of

87− Nothing -> throw (userError "Invalid integer")

87+ Nothing -> throwIO (userError "Invalid integer")

88 Just i -> return i

90-- | Read an exact number of bytes from a socket

@@ -94,7 +94,7 @@ recvInt32 sock = do

94recvExact :: N.Socket -- ^ Socket to read from

95 -> Int32 -- ^ Number of bytes to read

96 -> IO [ByteString]

97−recvExact _ len | len <= 0 = throw (userError "Negative length")

97+recvExact _ len | len <= 0 = throwIO (userError "Negative length")

98recvExact sock len = go [] len

99 where

100 go :: [ByteString] -> Int32 -> IO [ByteString]

@@ -102,5 +102,5 @@ recvExact sock len = go [] len

102 go acc l = do

103 bs <- NBS.recv sock (fromIntegral l `min` 4096)

104 if BS.null bs

105− then throw (userError "Socket closed")

105+ then throwIO (userError "Socket closed")

106 else go (bs : acc) (l - fromIntegral (BS.length bs))

network-transport/src/Network/Transport/TCP.hs+14−10

@@ -80,7 +80,7 @@ import Control.Monad.Error (ErrorT(..), runErrorT)

80import Control.Exception ( IOException

81 , SomeException

82 , handle

83− , throw

83+ , throwIO

84 , try

85 , bracketOnError

86 , mask

@@ -475,6 +475,10 @@ apiClose (ourEndPoint, theirEndPoint) connId connAlive = void . tryIO $ do

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

476apiSend :: EndPointPair -> ConnectionId -> IORef Bool -> [ByteString] -> IO (Either (TransportError SendErrorCode) ())

477apiSend (ourEndPoint, theirEndPoint) connId connAlive payload =

478+ -- The 'join' joins the inner exception that we explicitly return) for

479+ -- instance if the connection is closed) with the outer exception (which is

480+ -- returned by 'try' when an exception is thrown by 'sendOn', and handled

481+ -- by 'withRemoteState')

478 join <$> (try . mapExceptionIO sendFailed $ withRemoteState (ourEndPoint, theirEndPoint)

482 join <$> (try . mapExceptionIO sendFailed $ withRemoteState (ourEndPoint, theirEndPoint)

479 -- RemoteEndPointInvalid

483 -- RemoteEndPointInvalid

480 (\_ -> fail "apiSend RELY violation")

484 (\_ -> fail "apiSend RELY violation")

@@ -636,7 +640,7 @@ createLocalEndPoint transport = do

636 }

640 }

637 return (TransportValid . (localEndPointAt addr ^= Just localEndPoint) . (nextEndPointId ^= ix + 1) $ vst, localEndPoint)

641 return (TransportValid . (localEndPointAt addr ^= Just localEndPoint) . (nextEndPointId ^= ix + 1) $ vst, localEndPoint)

638 TransportClosed ->

642 TransportClosed ->

639− throw (TransportError NewEndPointFailed "Transport closed")

643+ throwIO (TransportError NewEndPointFailed "Transport closed")

640

644

641-- | Request a connection to a remote endpoint

645-- | Request a connection to a remote endpoint

642--

646--

@@ -676,7 +680,7 @@ requestConnectionTo ourEndPoint theirAddress = go

676 -- won't matter.

680 -- won't matter.

677 case endPointStateSnapshot of

681 case endPointStateSnapshot of

678 RemoteEndPointInvalid err ->

682 RemoteEndPointInvalid err ->

679− throw err

683+ throwIO err

680

684

681 RemoteEndPointClosing resolved _ ->

685 RemoteEndPointClosing resolved _ ->

682 -- If the remote endpoint is closing, then we need to block until

686 -- If the remote endpoint is closing, then we need to block until

@@ -700,7 +704,7 @@ requestConnectionTo ourEndPoint theirAddress = go

700 reply <- mapExceptionIO connectFailed $ doRemoteRequest (ourEndPoint, theirEndPoint) RequestConnectionId

704 reply <- mapExceptionIO connectFailed $ doRemoteRequest (ourEndPoint, theirEndPoint) RequestConnectionId

701 case decodeInt32 . BS.concat $ reply of

705 case decodeInt32 . BS.concat $ reply of

702 Nothing ->

706 Nothing ->

703− throw (connectFailed $ userError "Invalid integer")

707+ throwIO (connectFailed $ userError "Invalid integer")

704 Just cid ->

708 Just cid ->

705 return (theirEndPoint, cid)

709 return (theirEndPoint, cid)

706

710

@@ -712,7 +716,7 @@ requestConnectionTo ourEndPoint theirAddress = go

712 findTheirEndPoint = do

716 findTheirEndPoint = do

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

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

714 LocalEndPointClosed ->

718 LocalEndPointClosed ->

715− throw (TransportError ConnectFailed "Local endpoint closed")

719+ throwIO (TransportError ConnectFailed "Local endpoint closed")

716 LocalEndPointValid vst ->

720 LocalEndPointValid vst ->

717 case vst ^. localConnectionTo theirAddress of

721 case vst ^. localConnectionTo theirAddress of

718 Just theirEndPoint ->

722 Just theirEndPoint ->

@@ -809,7 +813,7 @@ socketToEndPoint :: EndPointAddress -- ^ Our address

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

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

810socketToEndPoint (EndPointAddress ourAddress) theirAddress = try $ do

814socketToEndPoint (EndPointAddress ourAddress) theirAddress = try $ do

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

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

812− Nothing -> throw (failed . userError $ "Could not parse")

816+ Nothing -> throwIO (failed . userError $ "Could not parse")

813 Just dec -> return dec

817 Just dec -> return dec

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

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

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

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

@@ -819,7 +823,7 @@ socketToEndPoint (EndPointAddress ourAddress) theirAddress = try $ do

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

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

820 recvInt32 sock

824 recvInt32 sock

821 case tryToEnum response of

825 case tryToEnum response of

822− Nothing -> throw (failed . userError $ "Unexpected response")

826+ Nothing -> throwIO (failed . userError $ "Unexpected response")

823 Just r -> return (sock, r)

827 Just r -> return (sock, r)

824 where

828 where

825 createSocket :: N.AddrInfo -> IO N.Socket

829 createSocket :: N.AddrInfo -> IO N.Socket

@@ -892,7 +896,7 @@ doRemoteRequest (ourEndPoint, theirEndPoint) header = do

892 let reqId = vst ^. nextCtrlRequestId

896 let reqId = vst ^. nextCtrlRequestId

893 return (LocalEndPointValid . (nextCtrlRequestId ^: (+ 1)) . (pendingCtrlRequestsAt reqId ^= Just reply) $ vst, reqId)

897 return (LocalEndPointValid . (nextCtrlRequestId ^: (+ 1)) . (pendingCtrlRequestsAt reqId ^= Just reply) $ vst, reqId)

894 LocalEndPointClosed ->

898 LocalEndPointClosed ->

895− throw (userError "Local endpoint closed")

899+ throwIO (userError "Local endpoint closed")

896 withRemoteState (ourEndPoint, theirEndPoint)

900 withRemoteState (ourEndPoint, theirEndPoint)

897 -- RemoteEndPointInvalid

901 -- RemoteEndPointInvalid

898 (\_ -> fail "doRemoteRequest RELY violation")

902 (\_ -> fail "doRemoteRequest RELY violation")

@@ -901,7 +905,7 @@ doRemoteRequest (ourEndPoint, theirEndPoint) header = do

901 -- RemoteEndPointClosing

905 -- RemoteEndPointClosing

902 (\_ -> fail "doRemoteRequest RELY violation")

906 (\_ -> fail "doRemoteRequest RELY violation")

903 -- RemoteEndPointClosed

907 -- RemoteEndPointClosed

904− (throw (userError "Remote endpoint closed"))

908+ (throwIO (userError "Remote endpoint closed"))

905 takeMVar reply

909 takeMVar reply

906

910

907-- | Check if the remote endpoint is unused, and if so, send a CloseSocket request

911-- | Check if the remote endpoint is unused, and if so, send a CloseSocket request

@@ -1012,7 +1016,7 @@ modifyRemoteState (ourEndPoint, theirEndPoint) caseInvalid caseValid caseClosing

1012 let err = TransportError (EventConnectionLost (remoteAddress theirEndPoint) incoming) (show ex)

1016 let err = TransportError (EventConnectionLost (remoteAddress theirEndPoint) incoming) (show ex)

1013 writeChan (localChannel ourEndPoint) $ ErrorEvent err

1017 writeChan (localChannel ourEndPoint) $ ErrorEvent err

1014 -- .. and finally rethrow the exception

1018 -- .. and finally rethrow the exception

1015− throw ex

1019+ throwIO ex

1016

1020

1017 -- Returns the set of incoming connections if we closed the connection, or

1021 -- Returns the set of incoming connections if we closed the connection, or

1018 -- 'Nothing' if the endpoint was already closed

1022 -- 'Nothing' if the endpoint was already closed

network-transport/tests/TestTCP.hs+6−6

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

24 )

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

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

27−import Control.Exception (throw, try, SomeException)

27+import Control.Exception (throwIO, try, SomeException)

28import Network.Transport.TCP ( ControlHeader(..)

29 , ConnectionRequestResponse(..)

30 , socketToEndPoint

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

135 putMVar clientAddr ourAddress

136

137 -- Listen for incoming messages

138− forkServer "127.0.0.1" clientPort 5 throw $ \sock -> do

138+ forkServer "127.0.0.1" clientPort 5 throwIO $ \sock -> do

139 -- Initial setup

140 0 <- recvInt32 sock :: IO Int

141 _ <- recvWithLength sock

@@ -246,7 +246,7 @@ testEarlyCloseSocket nextPort = do

246 putMVar clientAddr ourAddress

247

248 -- Listen for incoming messages

249− forkServer "127.0.0.1" clientPort 5 throw $ \sock -> do

249+ forkServer "127.0.0.1" clientPort 5 throwIO $ \sock -> do

250 -- Initial setup

251 0 <- recvInt32 sock :: IO Int

252 _ <- recvWithLength sock

@@ -509,7 +509,7 @@ testMany nextPort = do

509 case (ioe_errno ex) of

510 Just no | Errno no == eADDRNOTAVAIL -> putStrLn "(ADDRNOTAVAIL)"

511 _ -> return ()

512− throw ex

512+ throwIO ex

513 Right transport ->

514 replicateM_ 3 $ do

515 Right endpoint <- newEndPoint transport

@@ -549,7 +549,7 @@ testReconnect nextPort = do

549

550 counter <- newMVar (0 :: Int)

551

552− forkServer "127.0.0.1" serverPort 5 throw $ \sock -> do

552+ forkServer "127.0.0.1" serverPort 5 throwIO $ \sock -> do

553 -- Accept the connection

554 Right 0 <- tryIO $ (recvInt32 sock :: IO Int)

555 Right _ <- tryIO $ recvWithLength sock

@@ -617,7 +617,7 @@ testUnidirectionalError nextPort = do

617 serverGotPing <- newEmptyMVar

618

619 -- Server

620− forkServer "127.0.0.1" serverPort 5 throw $ \sock -> do

620+ forkServer "127.0.0.1" serverPort 5 throwIO $ \sock -> do

621 -- We accept connections, but when an exception occurs we don't do

622 -- anything (in particular, we don't close the socket). This is important

623 -- because when we shutdown one direction of the socket a recv here will

network-transport/tests/TestTransport.hs−1

@@ -16,7 +16,6 @@ import Data.Map (Map)

16import qualified Data.Map as Map (empty, insert, delete, findWithDefault, adjust, null, toList, map)

17import Data.String (fromString)

18import Traced

19−import Control.Concurrent (threadDelay)

21-- | We overload connect to always pass the default hints

20-- | We overload connect to always pass the default hints

22connect :: EndPoint -> EndPointAddress -> Reliability -> IO (Either (TransportError ConnectErrorCode) Connection)

21connect :: EndPoint -> EndPointAddress -> Reliability -> IO (Either (TransportError ConnectErrorCode) Connection)

network-transport/tests/Traced.hs+4−4

@@ -52,7 +52,7 @@ module Traced ( MonadS(..)

53import Prelude hiding ((>>=), return, fail, catch, (>>))

54import qualified Prelude

55−import Control.Exception (catches, Handler(..), SomeException, throw, Exception(..), IOException)

55+import Control.Exception (catches, Handler(..), SomeException, throwIO, Exception(..), IOException)

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

57import Data.Typeable (Typeable)

58import Data.Maybe (catMaybes)

@@ -180,9 +180,9 @@ instance Show TracedException where

180

181traceHandlers :: Traceable a => a -> [Handler b]

182traceHandlers a = case trace a of

183− Nothing -> [ Handler $ \ex -> throw (ex :: SomeException) ]

183+ Nothing -> [ Handler $ \ex -> throwIO (ex :: SomeException) ]

184− Just t -> [ Handler $ \(TracedException ts ex) -> throw $ TracedException (show t : ts) ex

184+ Just t -> [ Handler $ \(TracedException ts ex) -> throwIO $ TracedException (show t : ts) ex

185− , Handler $ \ex -> throw $ TracedException [show t] (ex :: SomeException)

185+ , Handler $ \ex -> throwIO $ TracedException [show t] (ex :: SomeException)

186 ]

187

188-- | Definition of 'ifThenElse' for use with RebindableSyntax