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