@@ -1,23 +1,44 @@
11module DemoTransport where
22
33import Network.Transport
4−import Network.Transport.MVar (mkTransport)
4+import qualified Network.Transport.MVar
5+import Network.Transport.TCP (mkTransport, TCPConfig (..))
56
67import Control.Concurrent
8+import Control.Monad
9+
710import qualified Data.ByteString.Char8 as BS
811
12+import Debug.Trace
13+
914-------------------------------------------
1015-- Example program using backend directly
1116--
1217
13−-- check the endpoint serialisation works
18+-- | Check if multiple messages can be sent on the same connection.
19+demo0 :: IO ()
20+demo0 = do
21+ trans <- mkTransport $ TCPConfig undefined "127.0.0.1" "8080"
22+
23+ (sendAddr, receiveEnd) <- newConnection trans
24+
25+ forkIO $ logServer "logServer" receiveEnd
26+ threadDelay 100000
27+
28+ sendEnd <- connect sendAddr
29+
30+ mapM_ (\n -> send sendEnd [BS.pack ("hello " ++ show n)]) [1 .. 10]
31+ threadDelay 100000
32+
33+-- | Check endpoint serialization and deserialization.
1434demo1 :: IO ()
1535demo1 = do
16− trans <- mkTransport
36+ -- trans <- mkTransport
37+ trans <- mkTransport $ TCPConfig undefined "127.0.0.1" "8080"
1738
1839 (sendAddr, receiveEnd) <- newConnection trans
1940
20− forkIO $ logServer receiveEnd
41+ forkIO $ logServer "logServer" receiveEnd
2142 threadDelay 100000
2243
2344 sendEnd <- connect sendAddr
@@ -30,24 +51,58 @@ demo1 = do
3051 send sendEnd' [BS.pack "hello 2"]
3152 threadDelay 100000
3253
33−-- check that we can send before any corresponding receive
54+-- | Check that messages can be sent before receive is set up.
3455demo2 :: IO ()
3556demo2 = do
36− trans <- mkTransport
57+ -- trans <- mkTransport
58+ trans <- mkTransport $ TCPConfig undefined "127.0.0.1" "8080"
3759
3860 (sendAddr, receiveEnd) <- newConnection trans
3961
4062 sendEnd <- connect sendAddr
41−
4263 forkIO $ send sendEnd [BS.pack "hello 1"]
4364 threadDelay 100000
44− forkIO $ logServer receiveEnd
45− threadDelay 100000
46− forkIO $ send sendEnd [BS.pack "hello 2"]
47− threadDelay 100000
4865
49−logServer :: ReceiveEnd -> IO ()
50−logServer receiveEnd = do
66+ forkIO $ logServer "logServer" receiveEnd
67+ return ()
68+
69+-- | Check that two different transports can be created.
70+demo3 :: IO ()
71+demo3 = do
72+ trans1 <- mkTransport $ TCPConfig undefined "127.0.0.1" "8080"
73+ trans2 <- mkTransport $ TCPConfig undefined "127.0.0.1" "8081"
74+
75+ (sendAddr1, receiveEnd1) <- newConnection trans1
76+ (sendAddr2, receiveEnd2) <- newConnection trans2
77+
78+ forkIO $ logServer "logServer1" receiveEnd1
79+ forkIO $ logServer "logServer2" receiveEnd2
80+
81+ sendEnd1 <- connect sendAddr1
82+ sendEnd2 <- connect sendAddr2
83+
84+ send sendEnd1 [BS.pack "hello1"]
85+ send sendEnd2 [BS.pack "hello2"]
86+
87+-- | Check that two different connections on the same transport can be created.
88+demo4 :: IO ()
89+demo4 = do
90+ trans <- mkTransport $ TCPConfig undefined "127.0.0.1" "8080"
91+ -- trans <- Network.Transport.MVar.mkTransport
92+
93+ (sendAddr1, receiveEnd1) <- newConnection trans
94+ (sendAddr2, receiveEnd2) <- newConnection trans
95+
96+ forkIO $ logServer "logServer1" receiveEnd1
97+ forkIO $ logServer "logServer2" receiveEnd2
98+
99+ sendEnd1 <- connect sendAddr1
100+ sendEnd2 <- connect sendAddr2
101+
102+ send sendEnd1 [BS.pack "hello1"]
103+ send sendEnd2 [BS.pack "hello2"]
104+
105+logServer :: String -> ReceiveEnd -> IO ()
106+logServer name receiveEnd = forever $ do
51107 x <- receive receiveEnd
52− print x
53− logServer receiveEnd
108+ trace (name ++ ": " ++ show x) $ return ()