--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gameServer/stresstest3.hs	Fri Jul 23 22:14:56 2010 +0400
@@ -0,0 +1,71 @@
+{-# LANGUAGE CPP #-}
+
+module Main where
+
+import IO
+import System.IO
+import Control.Concurrent
+import Network
+import Control.OldException
+import Control.Monad
+import System.Random
+import Control.Monad.State
+import Data.List
+
+#if !defined(mingw32_HOST_OS)
+import System.Posix
+#endif
+
+type SState = Handle
+io = liftIO
+
+        
+readPacket :: StateT SState IO [String]
+readPacket = do
+    h <- get
+    p <- io $ hGetPacket h []
+    return p
+    where
+    hGetPacket h buf = do
+        l <- hGetLine h
+        if (not $ null l) then hGetPacket h (buf ++ [l]) else return buf
+
+waitPacket :: String -> StateT SState IO Bool
+waitPacket s = do
+    p <- readPacket
+    return $ head p == s
+
+sendPacket :: [String] -> StateT SState IO ()
+sendPacket s = do
+    h <- get
+    io $ do
+        mapM_ (hPutStrLn h) s
+        hPutStrLn h ""
+        hFlush h
+
+emulateSession :: StateT SState IO ()
+emulateSession = do
+    waitPacket "CONNECTED"
+    sendPacket ["NICK", "test"]
+    waitPacket "NICK"
+    sendPacket ["PROTO", "31"]
+    waitPacket "PROTO"
+    b <- waitPacket "LOBBY:JOINED"
+    io $ print b
+
+testing = Control.OldException.handle print $ do
+    putStrLn "Start"
+    sock <- connectTo "127.0.0.1" (PortNumber 46631)
+    evalStateT emulateSession sock
+    putStrLn "Finish"
+
+forks = forever $ do
+    delay <- randomRIO (400000::Int, 600000)
+    threadDelay delay
+    forkIO testing
+
+main = withSocketsDo $ do
+#if !defined(mingw32_HOST_OS)
+    installHandler sigPIPE Ignore Nothing;
+#endif
+    forks