@@ -17,9 +17,8 @@ import Data.ByteString.Char8 (pack, unpack)
1717import qualified Data.ByteString as BS
1818import qualified Network.Socket.ByteString as NBS
1919import Data.Time (getCurrentTime, diffUTCTime, NominalDiffTime)
20−import Network.Transport (newConnection, receive, connect, send, defaultHints,
21− serialize, deserialize, SourceEnd, TargetEnd)
22−import Network.Transport.TCP (mkTransport, TCPConfig (..))
20+import Network.Transport
21+import Network.Transport.TCP
2322
2423main :: IO ()
2524main = do
@@ -30,66 +29,67 @@ main = do
3029
3130 -- Start the server
3231 forkIO $ do
33− -- establish transport
32+ -- establish transport and endpoint
3433 putStrLn "server: creating TCP connection"
35− transport <- mkTransport $ TCPConfig defaultHints "127.0.0.1" "8080"
34+ Right transport <- createTransport "127.0.0.1" "8080" defaultTCPParameters
35+ Right endpoint <- newEndPoint transport
36+ putMVar serverAddr (address endpoint)
3637
37− -- create ping end
38− (sourceAddrPing, targetEndPing) <- newConnection transport
39− putMVar serverAddr sourceAddrPing
40−
41− -- create pong end
42− sourceAddrPong <- takeMVar clientAddr
43− sourceEndPong <- connect sourceAddrPong
38+ -- Connect to the client so that we can reply
39+ theirAddr <- takeMVar clientAddr
40+ Right conn <- connect endpoint theirAddr ReliableOrdered defaultConnectHints
4441
4542 -- reply to pings with pongs
4643 putStrLn "server: awaiting client connection"
47− pong targetEndPing sourceEndPong
44+ ConnectionOpened _ _ _ <- receive endpoint
45+ pong endpoint conn
4846
4947 -- Start the client
5048 forkIO $ do
51− sourceAddr <- takeMVar serverAddr
5249 let pings = read pingsStr
5350
54− -- establish transport
55− transport <- mkTransport $ TCPConfig defaultHints "127.0.0.1" "8081"
51+ -- establish transport and endpoint
52+ Right transport <- createTransport "127.0.0.1" "8081" defaultTCPParameters
53+ Right endpoint <- newEndPoint transport
54+ putMVar clientAddr (address endpoint)
5655
57− -- Create ping end
58− sourceEndPing <- connect sourceAddr
56+ -- Connect to the server to send pings
57+ theirAddr <- takeMVar serverAddr
58+ Right conn <- connect endpoint theirAddr ReliableOrdered defaultConnectHints
5959
60− -- Create pong end
61− (sourceAddrPong, targetEndPong) <- newConnection transport
62− putMVar clientAddr sourceAddrPong
63−
64− ping sourceEndPing targetEndPong pings
60+ -- Send pings, waiting for a reply after every ping
61+ ConnectionOpened _ _ _ <- receive endpoint
62+ ping endpoint conn pings
6563 putMVar clientDone ()
6664
6765 -- Wait for the client to finish
6866 takeMVar clientDone
6967
70−pingMessage :: ByteString
71−pingMessage = pack "ping123"
68+pingMessage :: [ByteString]
69+pingMessage = [pack "ping123"]
7270
73−ping :: SourceEnd -> TargetEnd -> Int -> IO ()
74−ping sourceEndPing targetEndPong pings = go pings
71+ping :: EndPoint -> Connection -> Int -> IO ()
72+ping endpoint conn pings = go pings
7573 where
7674 go :: Int -> IO ()
7775 go 0 = do
7876 putStrLn $ "client did " ++ show pings ++ " pings"
7977 go !i = do
8078 before <- getCurrentTime
81− send sourceEndPing [pingMessage]
82− [bs] <- receive targetEndPong
79+ send conn pingMessage
80+ Received _ _payload <- receive endpoint
8381 after <- getCurrentTime
84− -- putStrLn $ "client received " ++ unpack bs
82+ -- putStrLn $ "client received " ++ show _payload
8583 let latency = (1e6 :: Double) * realToFrac (diffUTCTime after before)
8684 hPutStrLn stderr $ show i ++ " " ++ show latency
8785 go (i - 1)
8886
89−pong :: TargetEnd -> SourceEnd -> IO ()
90−pong targetEndPing sourceEndPong = do
91− [bs] <- receive targetEndPing
92− -- putStrLn $ "server received " ++ unpack bs
93− when (BS.length bs > 0) $ do
94− send sourceEndPong [bs]
95− pong targetEndPing sourceEndPong
87+pong :: EndPoint -> Connection -> IO ()
88+pong endpoint conn = go
89+ where
90+ go = do
91+ msg <- receive endpoint
92+ case msg of
93+ Received _ payload -> send conn payload >> go
94+ ConnectionClosed _ -> return ()
95+ _ -> fail "Unexpected message"