netserver/stresstest.hs
author unc0rr
Mon, 19 Jan 2009 15:44:44 +0000
changeset 1720 220faa4fa922
parent 1498 264e11b5c639
permissions -rw-r--r--
New grave
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1498
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
     1
module Main where
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
     2
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
     3
import IO
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
     4
import System.IO
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
     5
import Control.Concurrent
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
     6
import Network
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
     7
import Control.Exception
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
     8
import Control.Monad
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
     9
import System.Random
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    10
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    11
session1 nick room = ["NICK", nick, "", "PROTO", "20", "", "CREATE", room, "", "CHAT_STRING", "Hi", ""]
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    12
session2 nick room = ["NICK", nick, "", "PROTO", "20", "",   "JOIN", room, "", "CHAT_STRING", "Hello", ""]
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    13
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    14
emulateSession sock s = do
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    15
	mapM_ (\x -> hPutStrLn sock x >> randomRIO (70000::Int, 120000) >>= threadDelay) s
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    16
	hFlush sock
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    17
	threadDelay 250000
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    18
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    19
testing = Control.Exception.handle (\e -> putStrLn $ show e) $ do
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    20
	putStrLn "Start"
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    21
	sock <- connectTo "127.0.0.1" (PortNumber 46631)
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    22
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    23
	num1 <- randomRIO (70000::Int, 70100)
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    24
	num2 <- randomRIO (70000::Int, 70100)
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    25
	num3 <- randomRIO (0::Int, 7)
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    26
	num4 <- randomRIO (0::Int, 7)
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    27
	let nick1 = show $ num1
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    28
	let nick2 = show $ num2
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    29
	let room1 = show $ num3
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    30
	let room2 = show $ num4
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    31
	emulateSession sock $ session1 nick1 room1
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    32
	emulateSession sock $ session2 nick2 room2
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    33
	emulateSession sock $ session2 nick1 room1
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    34
	hClose sock
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    35
	putStrLn "Finish"
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    36
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    37
forks = forever $ do
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    38
	delay <- randomRIO (40000::Int, 70000)
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    39
	threadDelay delay
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    40
	forkIO testing
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    41
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    42
main = withSocketsDo $ do
264e11b5c639 Stress testing app
unc0rr
parents:
diff changeset
    43
	forks