@@ -1,107 +0,0 @@
1−{-# LANGUAGE CPP, BangPatterns #-}
8−import qualified Data.Serialize as Ser
9−import Data.Word (Word8)
11− ( AddrInfoFlag (AI_PASSIVE), HostName, ServiceName, Socket
12− , SocketType (Stream), SocketOption (ReuseAddr)
13− , accept, addrAddress, addrFlags, addrFamily, bindSocket, defaultProtocol
15− , getAddrInfo, listen, setSocketOption, socket, sClose, withSocketsDo )
16−import System.Environment (getArgs, withArgs)
17−import Data.Time (getCurrentTime, diffUTCTime, NominalDiffTime)
18−import System.IO (withFile, IOMode(..), hPutStrLn, Handle, stderr)
19−import Control.Concurrent (forkIO)
20−import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar)
21−import qualified Network.Socket as N
23−import Data.ByteString (ByteString)
24−import Data.ByteString.Char8 (pack, unpack)
25−import qualified Data.ByteString as BS
26−import qualified Network.Socket.ByteString as NBS
27−import Data.Time (getCurrentTime, diffUTCTime, NominalDiffTime)
31− [pingsStr] <- getArgs
32− serverReady <- newEmptyMVar
33− clientDone <- newEmptyMVar
37− putStrLn "server: creating TCP connection"
38− serverAddrs <- getAddrInfo
39− (Just (defaultHints { addrFlags = [AI_PASSIVE] } ))
42− let serverAddr = head serverAddrs
43− sock <- socket (addrFamily serverAddr) Stream defaultProtocol
44− setSocketOption sock ReuseAddr 1
45− bindSocket sock (addrAddress serverAddr)
47− putStrLn "server: awaiting client connection"
48− putMVar serverReady ()
50− (clientSock, clientAddr) <- accept sock
52− putStrLn "server: listening for pings"
58− let pings = read pingsStr
59− serverAddrs <- getAddrInfo
63− let serverAddr = head serverAddrs
64− sock <- socket (addrFamily serverAddr) Stream defaultProtocol
66− N.connect sock (addrAddress serverAddr)
69− putMVar clientDone ()
71− -- Wait for the client to be complete
74−pingMessage :: ByteString
75−pingMessage = pack "ping123"
77−ping :: Socket -> Int -> IO ()
78−ping sock pings = go pings
82− putStrLn $ "client did " ++ show pings ++ " pings"
84− before <- getCurrentTime
85− send sock pingMessage
87− after <- getCurrentTime
88− -- putStrLn $ "client received " ++ unpack bs
89− let latency = (1e6 :: Double) * realToFrac (diffUTCTime after before)
90− hPutStrLn stderr $ show i ++ " " ++ show latency
93−pong :: Socket -> IO ()
96− -- putStrLn $ "server received " ++ unpack bs
97− when (BS.length bs > 0) $ do
101−-- | Wrapper around NBS.recv (for profiling)
102−recv :: Socket -> Int -> IO ByteString
105−-- | Wrapper around NBS.send (for profiling)
106−send :: Socket -> ByteString -> IO Int