git.iko.soy/distributed-process
on master help sign in
Simple chat client
8850548Edsko de Vries
network-transport-2/src/Network/Transport.hs+1−4
compare with master
unifiedsplit
@@ -20,7 +20,6 @@ module Network.Transport ( -- * Types
20
20
21import Data.ByteString (ByteString)
21import Data.ByteString (ByteString)
22import Control.Monad.Error (Error(..))
22import Control.Monad.Error (Error(..))
23−import Data.Int (Int32)
24
23
25--------------------------------------------------------------------------------
24--------------------------------------------------------------------------------
26-- Main API --
25-- Main API --
@@ -64,9 +63,7 @@ data Event =
64 deriving Show
63 deriving Show
65
64
66-- | Connection IDs enable receivers to distinguish one connection from another.
65-- | Connection IDs enable receivers to distinguish one connection from another.
67−--
68−-- TODO: Do we want an Int32 at the API level? (Change to Int perhaps?)
69−type ConnectionId = Int32
66+type ConnectionId = Int
70
67
71-- | Reliability guarantees of a connection.
68-- | Reliability guarantees of a connection.
72data Reliability =
69data Reliability =
network-transport-2/tests/chat/ChatClient.hsnew file+107
@@ -0,0 +1,107 @@
1+import System.Environment (getArgs)
2+import Network.Transport
3+import Network.Transport.TCP (createTransport)
4+import Control.Concurrent.MVar (MVar, newEmptyMVar, takeMVar, putMVar, newMVar, readMVar, modifyMVar_, modifyMVar)
5+import Control.Concurrent (forkIO)
6+import Control.Monad (forever, forM, unless, when)
7+import qualified Data.ByteString as BS (concat, null)
8+import qualified Data.ByteString.Char8 as BSC (pack, unpack, getLine)
9+import Data.Map (Map)
10+import qualified Data.Map as Map (fromList, elems, insert, member, empty, size, delete, (!))
11+
12+chatClient :: MVar () -> EndPoint -> EndPointAddress -> IO ()
13+chatClient done endpoint serverAddr = do
14+ connect endpoint serverAddr ReliableOrdered
15+ cOut <- getPeers >>= connectToPeers
16+ cIn <- newMVar Map.empty
17+
18+ -- Listen for incoming messages
19+ forkIO . forever $ do
20+ event <- receive endpoint
21+ case event of
22+ Received _ msg ->
23+ putStrLn . BSC.unpack . BS.concat $ msg
24+ ConnectionOpened cid _ addr -> do
25+ modifyMVar_ cIn $ return . Map.insert cid addr
26+ didAdd <- modifyMVar cOut $ \conns ->
27+ if not (Map.member addr conns)
28+ then do
29+ Right conn <- connect endpoint addr ReliableOrdered
30+ return (Map.insert addr conn conns, True)
31+ else
32+ return (conns, False)
33+ when didAdd $ showNumPeers cOut
34+ ConnectionClosed cid -> do
35+ addr <- modifyMVar cIn $ \conns ->
36+ return (Map.delete cid conns, conns Map.! cid)
37+ modifyMVar_ cOut $ \conns -> do
38+ close (conns Map.! addr)
39+ return (Map.delete addr conns)
40+ showNumPeers cOut
41+
42+
43+
44+{-
45+ chatState <- newMVar (Map.fromList peerConns)
46+
47+ -- Thread to listen to incoming messages
48+ forkIO . forever $ do
49+ event <- receive endpoint
50+ case event of
51+ ConnectionOpened _ _ (EndPointAddress addr) -> do
52+ modifyMVar_ chatState $ \peers ->
53+ if not (Map.member addr peers)
54+ then do
55+ Right conn <- connect endpoint (EndPointAddress addr) ReliableOrdered
56+ return (Map.insert addr conn peers)
57+ else
58+ return peers
59+ Received _ msg ->
60+ putStrLn . BSC.unpack . BS.concat $ msg
61+ ConnectionClosed _ ->
62+ return ()
63+
64+-}
65+ -- Thread to interact with the user
66+ showNumPeers cOut
67+ let go = do
68+ msg <- BSC.getLine
69+ unless (BS.null msg) $ do
70+ readMVar cOut >>= \conns -> forM (Map.elems conns) $ \conn -> send conn [msg]
71+ go
72+ go
73+ putMVar done ()
74+
75+ where
76+ getPeers :: IO [EndPointAddress]
77+ getPeers = do
78+ ConnectionOpened _ _ _ <- receive endpoint
79+ Received _ msg <- receive endpoint
80+ ConnectionClosed _ <- receive endpoint
81+ return . map EndPointAddress . read . BSC.unpack . BS.concat $ msg
82+
83+ connectToPeers :: [EndPointAddress] -> IO (MVar (Map EndPointAddress Connection))
84+ connectToPeers addrs = do
85+ conns <- forM addrs $ \addr -> do
86+ Right conn <- connect endpoint addr ReliableOrdered
87+ return (addr, conn)
88+ newMVar (Map.fromList conns)
89+
90+ showNumPeers :: MVar (Map EndPointAddress Connection) -> IO ()
91+ showNumPeers cOut =
92+ readMVar cOut >>= \conns -> putStrLn $ "# " ++ show (Map.size conns) ++ " peers"
93+
94+
95+
96+
97+main :: IO ()
98+main = do
99+ host:port:server:_ <- getArgs
100+ Right transport <- createTransport host port
101+ Right endpoint <- newEndPoint transport
102+ clientDone <- newEmptyMVar
103+
104+ forkIO $ chatClient clientDone endpoint (EndPointAddress . BSC.pack $ server)
105+
106+ takeMVar clientDone
107+
network-transport-2/tests/chat/ChatServer.hsnew file+28
@@ -0,0 +1,28 @@
1+import System.Environment (getArgs)
2+import Network.Transport
3+import Network.Transport.TCP (createTransport)
4+import Control.Monad.State (evalStateT, modify, get)
5+import Control.Monad (forever)
6+import Control.Monad.IO.Class (liftIO)
7+import qualified Data.IntMap as IntMap (empty, insert, delete, elems)
8+import qualified Data.ByteString.Char8 as BSC (pack)
9+
10+main :: IO ()
11+main = do
12+ host:port:_ <- getArgs
13+ Right transport <- createTransport host port
14+ Right endpoint <- newEndPoint transport
15+
16+ putStrLn $ "Chat server ready at " ++ (show . endPointAddressToByteString . address $ endpoint)
17+
18+ flip evalStateT IntMap.empty . forever $ do
19+ event <- liftIO $ receive endpoint
20+ case event of
21+ ConnectionOpened cid _ addr -> do
22+ get >>= \clients -> liftIO $ do
23+ Right conn <- connect endpoint addr ReliableOrdered
24+ send conn [BSC.pack . show . IntMap.elems $ clients]
25+ close conn
26+ modify $ IntMap.insert cid (endPointAddressToByteString addr)
27+ ConnectionClosed cid ->
28+ modify $ IntMap.delete cid