gameServer/ClientIO.hs
author nemo
Tue, 08 Sep 2009 19:44:49 +0000
changeset 2357 babe1a55e284
parent 2352 7eaf82cf0890
child 2867 9be6693c78cb
permissions -rw-r--r--
Add an empty weapon to avoid selection of weapons which aren't yet ready. Might all be useful to switch to amNothing in certain situations, like after using up all ropes, instead of bazooka.

{-# LANGUAGE ScopedTypeVariables #-}
module ClientIO where

import qualified Control.Exception as Exception
import Control.Concurrent.Chan
import Control.Monad
import System.IO
----------------
import CoreTypes

listenLoop :: Handle -> Int -> [String] -> Chan CoreMessage -> Int -> IO ()
listenLoop handle linesNumber buf chan clientID = do
	str <- hGetLine handle
	if (linesNumber > 50) || (length str > 450) then
		writeChan chan $ ClientMessage (clientID, ["QUIT", "Protocol violation"])
		else
		if str == "" then do
			writeChan chan $ ClientMessage (clientID, buf)
			listenLoop handle 0 [] chan clientID
			else
			listenLoop handle (linesNumber + 1) (buf ++ [str]) chan clientID

clientRecvLoop :: Handle -> Chan CoreMessage -> Int -> IO ()
clientRecvLoop handle chan clientID =
	listenLoop handle 0 [] chan clientID
		`catch` (\e -> clientOff (show e) >> return ())
	where clientOff msg = writeChan chan $ ClientMessage (clientID, ["QUIT", msg]) -- if the client disconnects, we perform as if it sent QUIT message

clientSendLoop :: Handle -> Chan CoreMessage -> Chan [String] -> Int -> IO()
clientSendLoop handle coreChan chan clientID = do
	answer <- readChan chan
	doClose <- Exception.handle
		(\(e :: Exception.IOException) -> if isQuit answer then return True else sendQuit e >> return False) $ do
		forM_ answer (hPutStrLn handle)
		hPutStrLn handle ""
		hFlush handle
		return $ isQuit answer

	if doClose then
		Exception.handle (\(_ :: Exception.IOException) -> putStrLn "error on hClose") $ hClose handle
		else
		clientSendLoop handle coreChan chan clientID

	where
		sendQuit e = writeChan coreChan $ ClientMessage (clientID, ["QUIT", show e])
		isQuit ("BYE":xs) = True
		isQuit _ = False