8bdb68c · distributed-process

git.iko.soy/distributed-process

on master help sign in

switched back to Char8 bytestrings; enhanced sendtransport so it's not just sending all 0s

8bdb68cAdam C. Foltzer15 years ago

benchmarks/PingTransport.hs+1−1

compare with master

unifiedsplit

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

10import Data.Int

11import System.Environment (getArgs, withArgs)

13−import qualified Data.ByteString as BS

13+import qualified Data.ByteString.Char8 as BS

15-- | This performs a ping benchmark on the TCP transport. This can be

16-- compiled using:

benchmarks/SendTransport.hs+13−9

@@ -3,15 +3,17 @@ module Main where

3import Network.Transport

4import Network.Transport.TCP (mkTransport, TCPConfig (..))

6+import Control.DeepSeq (deepseq)

6−import Control.Monad (forever, replicateM_)

7+import Control.Monad (forever, replicateM, replicateM_)

7import Criterion.Main (Benchmark, bench, defaultMain, nfIO)

8import Criterion.Main (Benchmark, bench, defaultMain, nfIO)

8−import Data.Binary

9+import Data.Serialize

9−import Data.ByteString.Lazy (ByteString)

10+import Data.ByteString (ByteString)

10import Data.Maybe (fromJust)

11import Data.Maybe (fromJust)

11import Data.Int

12import Data.Int

12import System.Environment (getArgs, withArgs)

13import System.Environment (getArgs, withArgs)

14+import System.Random

14−import qualified Data.ByteString.Lazy as BS

16+import qualified Data.ByteString.Char8 as BS

16-- | This performs a benchmark on the TCP transport to measure how long

18-- | This performs a benchmark on the TCP transport to measure how long

17-- it takes to transfer a number of bytes. This can be compiled using:

19-- it takes to transfer a number of bytes. This can be compiled using:

@@ -67,17 +69,19 @@ main = do

67 send sourceEndPing [serialize sourceAddrPong]

69 send sourceEndPing [serialize sourceAddrPong]

69 -- benchmark the data

71 -- benchmark the data

70− let bs = BS.replicate size 0

72+ rands <- replicateM size randomIO

73+ let bs' = BS.pack (rands `deepseq` (rands :: [Char]))

74+ bs = BS.unpack bs' `deepseq` bs'

71 withArgs args' $ defaultMain [ benchSend sourceEndPing targetEndPong bs ]

75 withArgs args' $ defaultMain [ benchSend sourceEndPing targetEndPong bs ]

73-- | The effect of `ping sourceEndPing targetEndPong bs` is to send the

77-- | The effect of `ping sourceEndPing targetEndPong bs` is to send the

74-- `ByteString` `bs` using `sourceEndPing`, and to then receive

78-- `ByteString` `bs` using `sourceEndPing`, and to then receive

75-- a single byte back from `targetEndPong`.

79-- a single byte back from `targetEndPong`.

76−ping :: SourceEnd -> TargetEnd -> ByteString -> IO Word8

80+ping :: SourceEnd -> TargetEnd -> ByteString -> IO Bool

77ping sourceEndPing targetEndPong bs = do

81ping sourceEndPing targetEndPong bs = do

78 send sourceEndPing [bs]

82 send sourceEndPing [bs]

79− [cs] <- receive targetEndPong

83+ cs <- receive targetEndPong

80− return $ decode cs

84+ return $! BS.head bs == BS.head (head cs)

82-- | This function takes a `TargetEnd` for the pings, and a `SourceEnd` for

86-- | This function takes a `TargetEnd` for the pings, and a `SourceEnd` for

83-- pongs. Whenever a ping is received from the `TargetEnd`, a pong is sent

87-- pongs. Whenever a ping is received from the `TargetEnd`, a pong is sent

@@ -85,7 +89,7 @@ ping sourceEndPing targetEndPong bs = do

85pong :: TargetEnd -> SourceEnd -> IO ()

89pong :: TargetEnd -> SourceEnd -> IO ()

86pong targetEndPing sourceEndPong = do

90pong targetEndPing sourceEndPong = do

87 bs <- receive targetEndPing

91 bs <- receive targetEndPing

88− send sourceEndPong [encode (0 :: Word8)]

92+ send sourceEndPong bs

90-- | The effect of `benchSend sourceEndPing targetEndPong bs` is to send

94-- | The effect of `benchSend sourceEndPing targetEndPong bs` is to send

91-- `bs` pings down `sourceEndPing` using the `ping` function. The time

95-- `bs` pings down `sourceEndPing` using the `ping` function. The time

examples/DemoTCP.hs+4−5

@@ -9,7 +9,7 @@ import Data.String

9import Network.Socket (HostName, ServiceName)

10import System.Environment

12−import qualified Data.ByteString as BS

12+import qualified Data.ByteString.Char8 as BS

14import Debug.Trace

@@ -42,7 +42,7 @@ main = do

42 (clientSourceEnds, masterTargetEnd) <- demoMaster transport sourceAddrFilePath numSlaves

43 zipWithM_

44 (\clientSourceEnd clientId ->

45− send clientSourceEnd [BS.pack . map (fromIntegral . ord) . show $ clientId])

45+ send clientSourceEnd [BS.pack . show $ clientId])

46 clientSourceEnds [0 .. numSlaves-1]

47 replicateM_ numSlaves $ do

48 [clientMessage] <- receive masterTargetEnd

@@ -59,10 +59,9 @@ main = do

59 (masterSourceEnd, slaveTargetEnd) <- demoSlave transport sourceAddrFilePath

60 [clientId] <- receive slaveTargetEnd

61 putStrLn $ "slave: received clientId: " ++ show clientId

62− let message = "Connected to slave: "

62+ let message = "Connected to slave: " ++ (BS.unpack clientId)

63− ++ (map (chr . fromIntegral) $ BS.unpack clientId)

65− send masterSourceEnd [BS.pack . map (fromIntegral . ord) $ message]

64+ send masterSourceEnd [BS.pack message]

66 putStrLn "slave: sent message to master"

65 putStrLn "slave: sent message to master"

68 closeSourceEnd masterSourceEnd

67 closeSourceEnd masterSourceEnd

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

@@ -12,7 +12,7 @@ module Network.Transport

12 , newMulticast

13 ) where

15−import Data.ByteString (ByteString)

15+import Data.ByteString.Char8 (ByteString)

17-- | The `Hints` and `SourceHints` provide hints to the underlying transport

18-- about the kind of connection that is required. This might include details

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

@@ -12,14 +12,10 @@ import Control.Concurrent.Chan

12import Control.Concurrent.MVar

13import Control.Monad (forever, forM_)

15−import Data.ByteString (ByteString)

15+import Data.ByteString.Char8 (ByteString)

16−import qualified Data.ByteString as BS

16+import qualified Data.ByteString.Char8 as BS

17import Data.ByteString.Internal

19−import Data.Conduit

20−import qualified Data.Conduit.Binary as CB

21−import Data.Conduit.Network

22−

23import Data.IntMap (IntMap)

19import Data.IntMap (IntMap)

24import qualified Data.IntMap as IntMap

20import qualified Data.IntMap as IntMap

@@ -121,7 +117,7 @@ mkSourceEnd host service chanId = withSocketsDo $ do

121 { send = {-# SCC "send" #-} \bss -> do

117 { send = {-# SCC "send" #-} \bss -> do

122 let size = fromIntegral (sum . map BS.length $ bss) :: Int64

118 let size = fromIntegral (sum . map BS.length $ bss) :: Int64

123 sizeStr | size < 255 = encode (fromIntegral size :: Word8)

119 sizeStr | size < 255 = encode (fromIntegral size :: Word8)

124− | otherwise = BS.cons 255 (encode size)

120+ | otherwise = BS.cons (toEnum 255) (encode size)

125 NBS.sendMany sock (sizeStr:bss)

121 NBS.sendMany sock (sizeStr:bss)

126 , closeSourceEnd = {-# SCC "closeSourceEnd" #-} sClose sock

122 , closeSourceEnd = {-# SCC "closeSourceEnd" #-} sClose sock

127 }

123 }