gameServer/stresstest3.hs
author nemo
Wed, 22 May 2013 22:46:49 -0400
changeset 9046 f8ea1b929b72
parent 7751 8c7f5c43ea5e
child 10460 8dcea9087d75
permissions -rw-r--r--
So when I first upsized these, I neglected to remove the pixelated version when generating. Corrected that to avoid sharp edges. Also aggressively optimised for smoothing. Also took advantage of SVG to drag dino bones to water level for mikade.

{-# LANGUAGE CPP #-}

module Main where

import System.IO
import System.IO.Error
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
    io $ hGetPacket h []
    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
    n <- io $ randomRIO (100000::Int, 100100)
    waitPacket "CONNECTED"
    sendPacket ["NICK", "test" ++ show n]
    waitPacket "NICK"
    sendPacket ["PROTO", "41"]
    waitPacket "PROTO"
    b <- waitPacket "LOBBY:JOINED"
    --io $ print b
    sendPacket ["QUIT", "BYE"]
    return ()

testing = Control.OldException.handle print $ do
    putStr "+"
    sock <- connectTo "127.0.0.1" (PortNumber 46631)
    evalStateT emulateSession sock
    --hClose sock
    putStr "-"
    hFlush stdout

forks = forever $ do
    delay <- randomRIO (0::Int, 80000)
    threadDelay delay
    forkIO testing

main = withSocketsDo $ do
#if !defined(mingw32_HOST_OS)
    installHandler sigPIPE Ignore Nothing;
#endif
    forks