3d07ccb · distributed-process

git.iko.soy/distributed-process

on master help sign in

Check for bounds when using toEnum

3d07ccbEdsko de Vries14 years ago

network-transport-2/network-transport.cabal+4−4

compare with master

unifiedsplit

@@ -20,7 +20,7 @@ Library

20 Network.Transport.Chan,

21 Network.Transport.TCP,

22 Network.Transport.Util

23− extensions: EmptyDataDecls, OverloadedStrings, ForeignFunctionInterface, FlexibleContexts, BangPatterns

23+ extensions: EmptyDataDecls, OverloadedStrings, ForeignFunctionInterface, FlexibleContexts, BangPatterns, ScopedTypeVariables

24 ghc-options: -Wall -fno-warn-unused-do-bind

25 HS-Source-Dirs: src

@@ -36,7 +36,7 @@ Test-Suite TestTCP

36 mtl,

37 transformers,

38 ansi-terminal

39− extensions: EmptyDataDecls, OverloadedStrings, ForeignFunctionInterface, FlexibleContexts, BangPatterns

39+ extensions: EmptyDataDecls, OverloadedStrings, ForeignFunctionInterface, FlexibleContexts, BangPatterns, ScopedTypeVariables

40 ghc-options: -Wall -fno-warn-unused-do-bind

41 HS-Source-Dirs: tests src

@@ -50,7 +50,7 @@ Test-Suite TestMulticastInMemory

50 mtl,

51 transformers,

52 ansi-terminal

53− extensions: EmptyDataDecls, OverloadedStrings, ForeignFunctionInterface, FlexibleContexts, BangPatterns

53+ extensions: EmptyDataDecls, OverloadedStrings, ForeignFunctionInterface, FlexibleContexts, BangPatterns, ScopedTypeVariables

54 ghc-options: -Wall -fno-warn-unused-do-bind

55 HS-Source-Dirs: tests src

@@ -64,6 +64,6 @@ Test-Suite TestInMemory

64 mtl,

65 transformers,

66 ansi-terminal

67− extensions: EmptyDataDecls, OverloadedStrings, ForeignFunctionInterface, FlexibleContexts, BangPatterns

67+ extensions: EmptyDataDecls, OverloadedStrings, ForeignFunctionInterface, FlexibleContexts, BangPatterns, ScopedTypeVariables

68 ghc-options: -Wall -fno-warn-unused-do-bind

69 HS-Source-Dirs: tests src

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

@@ -10,6 +10,7 @@ module Network.Transport.Internal ( -- * Encoders/decoders

10 , failWithIO

11 , tryIO

12 , whileM

13+ , tryToEnum

13 -- * Debugging

14 -- * Debugging

14 , tlog

15 , tlog

15 , loopInvariant

16 , loopInvariant

@@ -41,28 +42,28 @@ encodeInt32 i32 =

41 pokeByteOff p 0 (htonl . fromIntegral . fromEnum $ i32)

42 pokeByteOff p 0 (htonl . fromIntegral . fromEnum $ i32)

43-- | Deserialize 32-bit from network byte order

44-- | Deserialize 32-bit from network byte order

44−decodeInt32 :: Enum a => ByteString -> Maybe a

45+decodeInt32 :: Num a => ByteString -> Maybe a

45decodeInt32 bs | BS.length bs /= 4 = Nothing

46decodeInt32 bs | BS.length bs /= 4 = Nothing

46decodeInt32 bs = Just . BSI.inlinePerformIO $ do

47decodeInt32 bs = Just . BSI.inlinePerformIO $ do

47 let (fp, _, _) = BSI.toForeignPtr bs

48 let (fp, _, _) = BSI.toForeignPtr bs

48 withForeignPtr fp $ \p -> do

49 withForeignPtr fp $ \p -> do

49 w32 <- peekByteOff p 0

50 w32 <- peekByteOff p 0

50− return (toEnum . fromIntegral . ntohl $ w32)

51+ return (fromIntegral . ntohl $ w32)

52-- | Serialize 16-bit to network byte order

53-- | Serialize 16-bit to network byte order

53encodeInt16 :: Enum a => a -> ByteString

54encodeInt16 :: Enum a => a -> ByteString

54encodeInt16 i16 =

55encodeInt16 i16 =

55 BSI.unsafeCreate 2 $ \p ->

56 BSI.unsafeCreate 2 $ \p ->

56− pokeByteOff p 0 (htons .fromIntegral . fromEnum $ i16)

57+ pokeByteOff p 0 (htons . fromIntegral . fromEnum $ i16)

58-- | Deserialize 16-bit from network byte order

59-- | Deserialize 16-bit from network byte order

59−decodeInt16 :: Enum a => ByteString -> Maybe a

60+decodeInt16 :: Num a => ByteString -> Maybe a

60decodeInt16 bs | BS.length bs /= 2 = Nothing

61decodeInt16 bs | BS.length bs /= 2 = Nothing

61decodeInt16 bs = Just . BSI.inlinePerformIO $ do

62decodeInt16 bs = Just . BSI.inlinePerformIO $ do

62 let (fp, _, _) = BSI.toForeignPtr bs

63 let (fp, _, _) = BSI.toForeignPtr bs

63 withForeignPtr fp $ \p -> do

64 withForeignPtr fp $ \p -> do

64 w16 <- peekByteOff p 0

65 w16 <- peekByteOff p 0

65− return (toEnum . fromIntegral . ntohs $ w16)

66+ return (fromIntegral . ntohs $ w16)

67-- | Prepend a list of bytestrings with their total length

68-- | Prepend a list of bytestrings with their total length

68prependLength :: [ByteString] -> [ByteString]

69prependLength :: [ByteString] -> [ByteString]

@@ -98,6 +99,10 @@ tlog msg = liftIO $ do

98 putStrLn $ show tid ++ ": " ++ msg

99 putStrLn $ show tid ++ ": " ++ msg

99-}

100-}

100

101

102+-- | Safe version of 'toEnum'

103+tryToEnum :: forall a. (Enum a, Bounded a) => Int -> Maybe a

104+tryToEnum n = if fromEnum (minBound :: a) <= n && n <= fromEnum (maxBound :: a) then Just (toEnum n) else Nothing

105+

101-- | Loop invariant (like 'guard')

106-- | Loop invariant (like 'guard')

102loopInvariant :: MonadPlus m => m Bool -> m ()

107loopInvariant :: MonadPlus m => m Bool -> m ()

103loopInvariant = (>>= guard)

108loopInvariant = (>>= guard)

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

@@ -50,7 +50,7 @@ recvWithLength :: N.Socket -> IO [ByteString]

50recvWithLength sock = recvInt32 sock >>= recvExact sock

52-- | Receive a 32-bit integer

53−recvInt32 :: Enum a => N.Socket -> IO a

53+recvInt32 :: Num a => N.Socket -> IO a

54recvInt32 sock = do

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

56 case mi of

network-transport-2/src/Network/Transport/TCP.hs+17−12

@@ -29,6 +29,7 @@ import Network.Transport.Internal ( encodeInt32

29 , failWith

30 , failWithIO

31 , tryIO

32+ , tryToEnum

32 )

33 )

33import qualified Network.Socket as N ( HostName

34import qualified Network.Socket as N ( HostName

34 , ServiceName

35 , ServiceName

@@ -61,7 +62,7 @@ import Data.IORef (IORef, newIORef, writeIORef, readIORef, modifyIORef)

61import Control.Category ((>>>))

62import Control.Category ((>>>))

62import Control.Applicative ((<*>), (*>), (<$>))

63import Control.Applicative ((<*>), (*>), (<$>))

63import Control.Monad (forM_, void, when)

64import Control.Monad (forM_, void, when)

64−import Control.Monad.Error (ErrorT(ErrorT), runErrorT)

65+import Control.Monad.Error (ErrorT(ErrorT), runErrorT, throwError)

65import Control.Monad.IO.Class (liftIO)

66import Control.Monad.IO.Class (liftIO)

66import Control.Exception (IOException)

67import Control.Exception (IOException)

67import Data.ByteString (ByteString)

68import Data.ByteString (ByteString)

@@ -250,14 +251,14 @@ data ControlHeader =

250 | CloseConnection -- ^ Tell the remote endpoint we will no longer be using a connection

251 | CloseConnection -- ^ Tell the remote endpoint we will no longer be using a connection

251 | ControlResponse -- ^ Respond to a control request _from_ the remote endpoint

252 | ControlResponse -- ^ Respond to a control request _from_ the remote endpoint

252 | CloseSocket -- ^ Request to close the connection (see module description)

253 | CloseSocket -- ^ Request to close the connection (see module description)

253− deriving Enum

254+ deriving (Enum, Bounded)

254

255

255-- Response sent by /B/ to /A/ when /A/ tries to connect

256-- Response sent by /B/ to /A/ when /A/ tries to connect

256data ConnectionRequestResponse =

257data ConnectionRequestResponse =

257 ConnectionRequestAccepted -- ^ /B/ accepts the connection

258 ConnectionRequestAccepted -- ^ /B/ accepts the connection

258 | ConnectionRequestEndPointInvalid -- ^ /A/ requested an invalid endpoint

259 | ConnectionRequestEndPointInvalid -- ^ /A/ requested an invalid endpoint

259 | ConnectionRequestCrossed -- ^ /A/s request crossed with a request from /B/ (see protocols)

260 | ConnectionRequestCrossed -- ^ /A/s request crossed with a request from /B/ (see protocols)

260− deriving Enum

261+ deriving (Enum, Bounded)

261

262

262--------------------------------------------------------------------------------

263--------------------------------------------------------------------------------

263-- Top-level functionality --

264-- Top-level functionality --

@@ -527,13 +528,14 @@ connectToRemoteEndPoint (ourEndPoint, theirEndPoint) = do

527 N.getAddrInfo Nothing (Just host) (Just port)

528 N.getAddrInfo Nothing (Just host) (Just port)

528 sock <- failWithIO (insufficientResources . show) $

529 sock <- failWithIO (insufficientResources . show) $

529 N.socket (N.addrFamily addr) N.Stream N.defaultProtocol

530 N.socket (N.addrFamily addr) N.Stream N.defaultProtocol

530− failWithIO (failed . show) $ do

531+ response <- failWithIO (failed . show) $ do

531 N.setSocketOption sock N.ReuseAddr 1

532 N.setSocketOption sock N.ReuseAddr 1

532 N.connect sock (N.addrAddress addr)

533 N.connect sock (N.addrAddress addr)

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

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

534− -- TODO: what happens when the server sends an int outside the range of ConnectionRequestResponse?

535+ recvInt32 sock

535− response <- recvInt32 sock

536+ case tryToEnum response of

537+ Nothing -> throwError (failed "Unexpected response")

536− return (response, sock)

538+ Just r -> return (r, sock)

537

539

538 invalidAddress, insufficientResources, failed :: String -> FailedWith ConnectErrorCode

540 invalidAddress, insufficientResources, failed :: String -> FailedWith ConnectErrorCode

539 invalidAddress = FailedWith ConnectInvalidAddress

541 invalidAddress = FailedWith ConnectInvalidAddress

@@ -667,19 +669,22 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do

667 readMessage sock connId

669 readMessage sock connId

668 go sock openConnections

670 go sock openConnections

669 else do

671 else do

670− case toEnum (fromIntegral connId) of

672+ case tryToEnum (fromIntegral connId) of

671− RequestConnectionId -> do

673+ Just RequestConnectionId -> do

672 recvInt32 sock >>= createNewConnection openConnections

674 recvInt32 sock >>= createNewConnection openConnections

673 go sock openConnections

675 go sock openConnections

674− ControlResponse -> do

676+ Just ControlResponse -> do

675 recvInt32 sock >>= readControlResponse sock

677 recvInt32 sock >>= readControlResponse sock

676 go sock openConnections

678 go sock openConnections

677− CloseConnection -> do

679+ Just CloseConnection -> do

678 recvInt32 sock >>= closeConnection openConnections

680 recvInt32 sock >>= closeConnection openConnections

679 go sock openConnections

681 go sock openConnections

680− CloseSocket -> do

682+ Just CloseSocket -> do

681 closeSocket sock

683 closeSocket sock

682 go sock openConnections

684 go sock openConnections

685+ Nothing ->

686+ -- Invalid control request, exit

687+ putStrLn "Warning: invalid control request"

683

688

684 -- Create a new connection

689 -- Create a new connection

685 createNewConnection :: IORef IntSet -> ControlRequestId -> IO ()

690 createNewConnection :: IORef IntSet -> ControlRequestId -> IO ()

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

@@ -10,6 +10,7 @@ import Data.Maybe (fromJust)

10import Control.Concurrent (threadDelay)

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

12import Control.Monad (replicateM, guard)

13+import Control.Applicative ((<$>))

13import Network.Transport.TCP ( decodeEndPointAddress

14import Network.Transport.TCP ( decodeEndPointAddress

14 , EndPointId

15 , EndPointId

15 , ControlHeader(..)

16 , ControlHeader(..)

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

68 sendMany sock (encodeInt32 endPointIx : prependLength [myAddress])

69 sendMany sock (encodeInt32 endPointIx : prependLength [myAddress])

70 -- Wait for acknowledgement

71 -- Wait for acknowledgement

71− ConnectionRequestAccepted <- recvInt32 sock

72+ ConnectionRequestAccepted <- toEnum <$> recvInt32 sock

73 -- Request a new connection, but don't wait for the response

74 -- Request a new connection, but don't wait for the response

74 let reqId = 0 :: Int32

75 let reqId = 0 :: Int32

@@ -163,7 +164,7 @@ testIgnoreCloseSocket = do

163 sendMany sock (encodeInt32 endPointIx : prependLength [myAddress])

164 sendMany sock (encodeInt32 endPointIx : prependLength [myAddress])

164

165

165 -- Wait for acknowledgement

166 -- Wait for acknowledgement

166− ConnectionRequestAccepted <- recvInt32 sock

167+ ConnectionRequestAccepted <- toEnum <$> recvInt32 sock

167

168

168 -- Request a new connection

169 -- Request a new connection

169 tlog "Requesting connection"

170 tlog "Requesting connection"

@@ -177,7 +178,7 @@ testIgnoreCloseSocket = do

177

178

178 -- Server will now send a CloseSocket request as its refcount reached 0

179 -- Server will now send a CloseSocket request as its refcount reached 0

179 tlog "Waiting for CloseSocket request"

180 tlog "Waiting for CloseSocket request"

180− CloseSocket <- recvInt32 sock

181+ CloseSocket <- toEnum <$> recvInt32 sock

181

182

182 -- But we ignore it and request another connection

183 -- But we ignore it and request another connection

183 tlog "Ignoring it, requesting another connection"

184 tlog "Ignoring it, requesting another connection"

@@ -191,7 +192,7 @@ testIgnoreCloseSocket = do

191

192

192 -- We now get a CloseSocket again, and this time we heed it

193 -- We now get a CloseSocket again, and this time we heed it

193 tlog "Waiting for second CloseSocket request"

194 tlog "Waiting for second CloseSocket request"

194− CloseSocket <- recvInt32 sock

195+ CloseSocket <- toEnum <$> recvInt32 sock

195

196

196 tlog "Closing socket"

197 tlog "Closing socket"

197 sendMany sock [encodeInt32 CloseSocket]

198 sendMany sock [encodeInt32 CloseSocket]

@@ -252,7 +253,7 @@ testBlockAfterCloseSocket = do

252 sendMany sock (encodeInt32 endPointIx : prependLength [myAddress])

253 sendMany sock (encodeInt32 endPointIx : prependLength [myAddress])

253

254

254 -- Wait for acknowledgement

255 -- Wait for acknowledgement

255− ConnectionRequestAccepted <- recvInt32 sock

256+ ConnectionRequestAccepted <- toEnum <$> recvInt32 sock

256

257

257 -- Request a new connection

258 -- Request a new connection

258 tlog "Requesting connection"

259 tlog "Requesting connection"

@@ -266,7 +267,7 @@ testBlockAfterCloseSocket = do

266

267

267 -- Server will now send a CloseSocket request as its refcount reached 0

268 -- Server will now send a CloseSocket request as its refcount reached 0

268 tlog "Waiting for CloseSocket request"

269 tlog "Waiting for CloseSocket request"

269− CloseSocket <- recvInt32 sock

270+ CloseSocket <- toEnum <$> recvInt32 sock

270

271

271 unblocked <- newEmptyMVar

272 unblocked <- newEmptyMVar

272

273