8bdb68c · distributed-process

git.iko.soy/distributed-process

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

commit8bdb68caddc248a0f9d03852ee1fa79dae7a1290 authorAdam C. Foltzer <acfoltzer@gmail.com> dateWed 22 Feb 2012, 21:36 (15 years ago) parent9ba9186

5 files changed+22−23

compare with master

unifiedsplit

benchmarks/PingTransport.hs+1−1 benchmarks/SendTransport.hs+13−9 examples/DemoTCP.hs+4−5 network-transport/src/Network/Transport.hs+1−1 network-transport/src/Network/Transport/TCP.hs+3−7

benchmarks/PingTransport.hs+1−1

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

1010import Data.Int

1111import System.Environment (getArgs, withArgs)

1212

13−import qualified Data.ByteString as BS

13+import qualified Data.ByteString.Char8 as BS

1414

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

1616-- compiled using:

benchmarks/SendTransport.hs+13−9

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

33import Network.Transport

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

6−import Control.Monad (forever, replicateM_)

6+import Control.DeepSeq (deepseq)

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

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

8−import Data.Binary

9−import Data.ByteString.Lazy (ByteString)

9+import Data.Serialize

10+import Data.ByteString (ByteString)

1011import Data.Maybe (fromJust)

1112import Data.Int

1213import System.Environment (getArgs, withArgs)

14+import System.Random

1315

14−import qualified Data.ByteString.Lazy as BS

16+import qualified Data.ByteString.Char8 as BS

1517

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

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

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

6769 send sourceEndPing [serialize sourceAddrPong]

6870

6971 -- 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'

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

7276

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

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

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

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

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

7781ping sourceEndPing targetEndPong bs = do

7882 send sourceEndPing [bs]

79− [cs] <- receive targetEndPong

80− return $ decode cs

83+ cs <- receive targetEndPong

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

8185

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

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

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

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

8690pong targetEndPing sourceEndPong = do

8791 bs <- receive targetEndPing

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

92+ send sourceEndPong bs

8993

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

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

examples/DemoTCP.hs+4−5

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

99import Network.Socket (HostName, ServiceName)

1010import System.Environment

1111

12−import qualified Data.ByteString as BS

12+import qualified Data.ByteString.Char8 as BS

1313

1414import Debug.Trace

1515

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

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

4343 zipWithM_

4444 (\clientSourceEnd clientId ->

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

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

4646 clientSourceEnds [0 .. numSlaves-1]

4747 replicateM_ numSlaves $ do

4848 [clientMessage] <- receive masterTargetEnd

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

5959 (masterSourceEnd, slaveTargetEnd) <- demoSlave transport sourceAddrFilePath

6060 [clientId] <- receive slaveTargetEnd

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

62− let message = "Connected to slave: "

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

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

6463

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

64+ send masterSourceEnd [BS.pack message]

6665 putStrLn "slave: sent message to master"

6766

6867 closeSourceEnd masterSourceEnd

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

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

1212 , newMulticast

1313 ) where

1414

15−import Data.ByteString (ByteString)

15+import Data.ByteString.Char8 (ByteString)

1616

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

1818-- 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

1212import Control.Concurrent.MVar

1313import Control.Monad (forever, forM_)

1414

15−import Data.ByteString (ByteString)

16−import qualified Data.ByteString as BS

15+import Data.ByteString.Char8 (ByteString)

16+import qualified Data.ByteString.Char8 as BS

1717import Data.ByteString.Internal

1818

19−import Data.Conduit

20−import qualified Data.Conduit.Binary as CB

21−import Data.Conduit.Network

22−

2319import Data.IntMap (IntMap)

2420import qualified Data.IntMap as IntMap

2521

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

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

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

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

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

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

125121 NBS.sendMany sock (sizeStr:bss)

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

127123 }