git.iko.soy/distributed-process
on master help sign in
fixed bugs in PingTransport benchmark and TCP
9ba9186Adam C. Foltzer
benchmarks/PingTransport.hs+8−7
@@ -5,12 +5,12 @@ import Network.Transport.TCP (mkTransport, TCPConfig (..))
5
5
6import Control.Monad (forever, replicateM_)
6import Control.Monad (forever, replicateM_)
7import Criterion.Main (Benchmark, bench, defaultMain, nfIO)
7import Criterion.Main (Benchmark, bench, defaultMain, nfIO)
8−import Data.Binary
8+import Data.Serialize
9import Data.Maybe (fromJust)
9import Data.Maybe (fromJust)
10import Data.Int
10import Data.Int
11import System.Environment (getArgs, withArgs)
11import System.Environment (getArgs, withArgs)
12
12
13−import qualified Data.ByteString.Lazy.Char8 as BS
13+import qualified Data.ByteString as BS
14
14
15-- | This performs a ping benchmark on the TCP transport. This can be
15-- | This performs a ping benchmark on the TCP transport. This can be
16-- compiled using:
16-- compiled using:
@@ -77,16 +77,17 @@ 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 -> IO Int64
80+ping :: SourceEnd -> TargetEnd -> Int64 -> IO Int64
81−ping sourceEndPing targetEndPong = do
81+ping sourceEndPing targetEndPong n = do
82− send sourceEndPing [BS.empty]
82+ send sourceEndPing [encode n]
83 [bs] <- receive targetEndPong
83 [bs] <- receive targetEndPong
84+ let (Right n) = decode bs
84− return $ decode bs
85+ return $! n
85
86
86-- | The effect of `benchPing sourceEndPing targetEndPong n` is to send
87-- | The effect of `benchPing sourceEndPing targetEndPong n` is to send
87-- `n` pings down `sourceEndPing` using the `ping` function. The time
88-- `n` pings down `sourceEndPing` using the `ping` function. The time
88-- taken is benchmarked.
89-- taken is benchmarked.
89benchPing :: SourceEnd -> TargetEnd -> Int64 -> Benchmark
90benchPing :: SourceEnd -> TargetEnd -> Int64 -> Benchmark
90benchPing sourceEndPing targetEndPong n = bench "PingTransport" $
91benchPing sourceEndPing targetEndPong n = bench "PingTransport" $
91− nfIO (replicateM_ (fromIntegral n) (ping sourceEndPing targetEndPong))
92+ nfIO (replicateM_ (fromIntegral n) (ping sourceEndPing targetEndPong 42))
92
93
network-transport/src/Network/Transport/TCP.hs+4−2
@@ -225,12 +225,14 @@ recvExact sock l = do
225 res <- createAndTrim (fromIntegral l) (go 0)
225 res <- createAndTrim (fromIntegral l) (go 0)
226 case BS.length res of
226 case BS.length res of
227 n | n == (fromIntegral l) -> return $ Right res
227 n | n == (fromIntegral l) -> return $ Right res
228+ n -> do
229+ printf "recvExact: expected %dB, got %dB\n" l n
228− _ -> return $ Left res
230+ return $ Left res
229 where
231 where
230 go :: Int -> Ptr Word8 -> IO Int
232 go :: Int -> Ptr Word8 -> IO Int
231 go n ptr | n == (fromIntegral l) = return n
233 go n ptr | n == (fromIntegral l) = return n
232 go n ptr = do
234 go n ptr = do
233− (p, off, len) <- toForeignPtr <$> NBS.recv sock n
235+ (p, off, len) <- toForeignPtr <$> NBS.recv sock (fromIntegral l)
234 if len == 0
236 if len == 0
235 then return n
237 then return n
236 else withForeignPtr p $ \p -> do
238 else withForeignPtr p $ \p -> do