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         

    23 readPacket :: StateT SState IO [String]

    24 readPacket = do

    25     h <- get

    26     p <- io $ hGetPacket h []

    27     return p

    28     where

    29     hGetPacket h buf = do

    30         l <- hGetLine h

    31         if (not $ null l) then hGetPacket h (buf ++ [l]) else return buf

    32 

    33 waitPacket :: String -> StateT SState IO Bool

    34 waitPacket s = do

    35     p <- readPacket

    36     return $ head p == s

    37 

    38 sendPacket :: [String] -> StateT SState IO ()

    39 sendPacket s = do

    40     h <- get

    41     io $ do

    42         mapM_ (hPutStrLn h) s

    43         hPutStrLn h ""

    44         hFlush h

    45 

    46 emulateSession :: StateT SState IO ()

    47 emulateSession = do

    48     waitPacket "CONNECTED"

    49     sendPacket ["NICK", "test"]

    50     waitPacket "NICK"

    51     sendPacket ["PROTO", "31"]

    52     waitPacket "PROTO"

    53     b <- waitPacket "LOBBY:JOINED"

    54     io $ print b

    55 

    56 testing = Control.OldException.handle print $ do

    57     putStrLn "Start"

    58     sock <- connectTo "127.0.0.1" (PortNumber 46631)

    59     evalStateT emulateSession sock

    60     putStrLn "Finish"

    61 

    62 forks = forever $ do

    63     delay <- randomRIO (400000::Int, 600000)

    64     threadDelay delay

    65     forkIO testing

    66 

    67 main = withSocketsDo $ do

    68 #if !defined(mingw32_HOST_OS)

    69     installHandler sigPIPE Ignore Nothing;

    70 #endif

    71     forks