git.iko.soy/distributed-process
on master help sign in
Allow 0 sized messages.
bb650cdNicolas Wu
benchmarks/PingTCP.hs+7−7
@@ -68,21 +68,21 @@ main = do
68 -- benchmark the pings
68 -- benchmark the pings
69 withArgs args' $ defaultMain [ benchPing sock pings ]
69 withArgs args' $ defaultMain [ benchPing sock pings ]
70
70
71−-- | Each `ping` sends a single `Int64`, and expects to receive one
71+-- | Each `ping` sends a single byte, and expects to receive one
72-- back in return.
72-- back in return.
73−ping :: Socket -> Int64 -> IO Int64
73+ping :: Socket -> IO Word8
74−ping sock n = do
74+ping sock = do
75− NBS.send sock $ encode n
75+ NBS.send sock $ encode (0 :: Word8)
76− bs <- NBS.recv sock 8
76+ bs <- NBS.recv sock 1
77 return $ decode bs
77 return $ decode bs
78
78
79pong :: Socket -> IO ()
79pong :: Socket -> IO ()
80pong sock = do
80pong sock = do
81− bs <- NBS.recv sock 8
81+ bs <- NBS.recv sock 1
82 NBS.sendAll sock bs
82 NBS.sendAll sock bs
83 return ()
83 return ()
84
84
85benchPing :: Socket -> Int64 -> Benchmark
85benchPing :: Socket -> Int64 -> Benchmark
86benchPing sock n = bench "TCP Ping" $
86benchPing sock n = bench "TCP Ping" $
87− nfIO (mapM_ (ping sock) [1 .. n])
87+ nfIO (replicateM_ (fromIntegral n) (ping sock))
88
88
benchmarks/PingTransport.hs+5−5
@@ -3,7 +3,7 @@ module Main where
3import Network.Transport
3import Network.Transport
4import Network.Transport.TCP (mkTransport, TCPConfig (..))
4import Network.Transport.TCP (mkTransport, TCPConfig (..))
5
5
6−import Control.Monad (forever)
6+import Control.Monad (forever, replicateM_)
7import Criterion.Main (Benchmark, bench, defaultMain, nfIO)
7import Criterion.Main (Benchmark, bench, defaultMain, nfIO)
8import Data.Binary
8import Data.Binary
9import Data.Maybe (fromJust)
9import Data.Maybe (fromJust)
@@ -77,9 +77,9 @@ pong targetEndPing sourceEndPong = do
77-- | The effect of `ping sourceEndPing targetEndPong n` is to send the number
77-- | The effect of `ping sourceEndPing targetEndPong n` is to send the number
78-- `n` using `sourceEndPing`, and to then receive the a number from
78-- `n` using `sourceEndPing`, and to then receive the a number from
79-- `targetEndPong`, which is then returned.
79-- `targetEndPong`, which is then returned.
80−ping :: SourceEnd -> TargetEnd -> Int64 -> IO Int64
80+ping :: SourceEnd -> TargetEnd -> IO Int64
81−ping sourceEndPing targetEndPong n = do
81+ping sourceEndPing targetEndPong = do
82− send sourceEndPing [encode n]
82+ send sourceEndPing [BS.empty]
83 [bs] <- receive targetEndPong
83 [bs] <- receive targetEndPong
84 return $ decode bs
84 return $ decode bs
85
85
@@ -88,5 +88,5 @@ ping sourceEndPing targetEndPong n = do
88-- taken is benchmarked.
88-- taken is benchmarked.
89benchPing :: SourceEnd -> TargetEnd -> Int64 -> Benchmark
89benchPing :: SourceEnd -> TargetEnd -> Int64 -> Benchmark
90benchPing sourceEndPing targetEndPong n = bench "Transport Ping" $
90benchPing sourceEndPing targetEndPong n = bench "Transport Ping" $
91− nfIO (mapM_ (ping sourceEndPing targetEndPong) [1 .. n])
91+ nfIO (replicateM_ (fromIntegral n) (ping sourceEndPing targetEndPong))
92
92
network-transport/src/Network/Transport/TCP.hs+3−3
@@ -100,11 +100,11 @@ mkSourceEnd host service chanId = withSocketsDo $ do
100 return SourceEnd
100 return SourceEnd
101 { send = \bss -> do
101 { send = \bss -> do
102 let size = fromIntegral (sum . map BS.length $ bss) :: Int64
102 let size = fromIntegral (sum . map BS.length $ bss) :: Int64
103− if size <= fromIntegral (maxBound :: Word8)
103+ if size < 255
104 then
104 then
105 NBS.sendAll sock (B.encode (fromIntegral size :: Word8))
105 NBS.sendAll sock (B.encode (fromIntegral size :: Word8))
106 else do
106 else do
107− NBS.sendAll sock (B.encode (0 :: Word8))
107+ NBS.sendAll sock (B.encode (255 :: Word8))
108 NBS.sendAll sock (B.encode size)
108 NBS.sendAll sock (B.encode size)
109 mapM_ (NBS.sendAll sock) bss
109 mapM_ (NBS.sendAll sock) bss
110 , closeSourceEnd = sClose sock
110 , closeSourceEnd = sClose sock
@@ -163,7 +163,7 @@ procMessages chans chanId chan sock = do
163 Nothing -> closeSocket
163 Nothing -> closeSocket
164 Just sizeBS -> do
164 Just sizeBS -> do
165 let size = fromIntegral (B.decode sizeBS :: Word8)
165 let size = fromIntegral (B.decode sizeBS :: Word8)
166− if size == 0
166+ if size == 255
167 then do
167 then do
168 mSizeBS' <- recvExact sock 8
168 mSizeBS' <- recvExact sock 8
169 case mSizeBS' of
169 case mSizeBS' of