gameServer/stresstest3.hs
changeset 4588 5ef5415c4ee1
parent 4529 467ab0685890
parent 4586 4ba4f021070f
child 4647 20b982afbe6e
equal deleted inserted replaced
4529:467ab0685890 4588:5ef5415c4ee1
     1 {-# LANGUAGE CPP #-}
       
     2 
       
     3 module Main where
       
     4 
       
     5 import IO
       
     6 import System.IO
       
     7 import Control.Concurrent
       
     8 import Network
       
     9 import Control.OldException
       
    10 import Control.Monad
       
    11 import System.Random
       
    12 import Control.Monad.State
       
    13 import Data.List
       
    14 
       
    15 #if !defined(mingw32_HOST_OS)
       
    16 import System.Posix
       
    17 #endif
       
    18 
       
    19 type SState = Handle
       
    20 io = liftIO
       
    21 
       
    22 readPacket :: StateT SState IO [String]
       
    23 readPacket = do
       
    24     h <- get
       
    25     p <- io $ hGetPacket h []
       
    26     return p
       
    27     where
       
    28     hGetPacket h buf = do
       
    29         l <- hGetLine h
       
    30         if (not $ null l) then hGetPacket h (buf ++ [l]) else return buf
       
    31 
       
    32 waitPacket :: String -> StateT SState IO Bool
       
    33 waitPacket s = do
       
    34     p <- readPacket
       
    35     return $ head p == s
       
    36 
       
    37 sendPacket :: [String] -> StateT SState IO ()
       
    38 sendPacket s = do
       
    39     h <- get
       
    40     io $ do
       
    41         mapM_ (hPutStrLn h) s
       
    42         hPutStrLn h ""
       
    43         hFlush h
       
    44 
       
    45 emulateSession :: StateT SState IO ()
       
    46 emulateSession = do
       
    47     n <- io $ randomRIO (100000::Int, 100100)
       
    48     waitPacket "CONNECTED"
       
    49     sendPacket ["NICK", "test" ++ (show n)]
       
    50     waitPacket "NICK"
       
    51     sendPacket ["PROTO", "31"]
       
    52     waitPacket "PROTO"
       
    53     b <- waitPacket "LOBBY:JOINED"
       
    54     --io $ print b
       
    55     sendPacket ["QUIT", "BYE"]
       
    56     return ()
       
    57 
       
    58 testing = Control.OldException.handle print $ do
       
    59     putStr "+"
       
    60     sock <- connectTo "127.0.0.1" (PortNumber 46631)
       
    61     evalStateT emulateSession sock
       
    62     --hClose sock
       
    63     putStr "-"
       
    64     hFlush stdout
       
    65 
       
    66 forks = forM_ [1..100] $ const $ do
       
    67     delay <- randomRIO (10000::Int, 30000)
       
    68     threadDelay delay
       
    69     forkIO testing
       
    70 
       
    71 main = withSocketsDo $ do
       
    72 #if !defined(mingw32_HOST_OS)
       
    73     installHandler sigPIPE Ignore Nothing;
       
    74 #endif
       
    75     forks