gameServer/stresstest.hs
author unc0rr
Fri, 01 May 2009 09:01:44 +0000
changeset 2021 a591afb43768
parent 1815 3d62cf9c350e
child 2352 7eaf82cf0890
permissions -rw-r--r--
Some changes in try to fix issue when you enter room with painted map, but frontend shows generated one (most probably bug is triggered by template filters) Untested.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     1
{-# LANGUAGE CPP #-}
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     2
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     3
module Main where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     4
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     5
import IO
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     6
import System.IO
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     7
import Control.Concurrent
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     8
import Network
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     9
import Control.Exception
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    10
import Control.Monad
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    11
import System.Random
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
#if !defined(mingw32_HOST_OS)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    14
import System.Posix
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    15
#endif
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    16
1815
3d62cf9c350e Save some more bytes in protocol
unc0rr
parents: 1804
diff changeset
    17
session1 nick room = ["NICK", nick, "", "PROTO", "24", "", "CHAT", "lobby 1", "", "CREATE", room, "", "CHAT", "room 1", "", "QUIT", "bye-bye", ""]
3d62cf9c350e Save some more bytes in protocol
unc0rr
parents: 1804
diff changeset
    18
session2 nick room = ["NICK", nick, "", "PROTO", "24", "", "LIST", "", "JOIN", room, "", "CHAT", "room 2", "", "PART", "", "CHAT", "lobby after part", "", "QUIT", "bye-bye", ""]
3d62cf9c350e Save some more bytes in protocol
unc0rr
parents: 1804
diff changeset
    19
session3 nick room = ["NICK", nick, "", "PROTO", "24", "", "LIST", "", "JOIN", room, "", "CHAT", "room 2", "", "QUIT", "bye-bye", ""]
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    20
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    21
emulateSession sock s = do
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    22
	mapM_ (\x -> hPutStrLn sock x >> hFlush sock >> randomRIO (50000::Int, 90000) >>= threadDelay) s
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    23
	hFlush sock
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    24
	threadDelay 225000
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    25
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    26
testing = Control.Exception.handle (\e -> putStrLn $ show e) $ do
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    27
	putStrLn "Start"
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    28
	sock <- connectTo "127.0.0.1" (PortNumber 46631)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    29
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    30
	num1 <- randomRIO (70000::Int, 70100)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    31
	num2 <- randomRIO (0::Int, 2)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    32
	num3 <- randomRIO (0::Int, 5)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    33
	let nick1 = show $ num1
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    34
	let room1 = show $ num2
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    35
	case num2 of 
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    36
		0 -> emulateSession sock $ session1 nick1 room1
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    37
		1 -> emulateSession sock $ session2 nick1 room1
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    38
		2 -> emulateSession sock $ session3 nick1 room1
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    39
	hClose sock
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    40
	putStrLn "Finish"
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    41
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    42
forks = forever $ do
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    43
	delay <- randomRIO (10000::Int, 19000)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    44
	threadDelay delay
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    45
	forkIO testing
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    46
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    47
main = withSocketsDo $ do
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    48
#if !defined(mingw32_HOST_OS)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    49
	installHandler sigPIPE Ignore Nothing;
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    50
#endif
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    51
	forks