diff -r 21dd1def5aaf -r 0eab727d4717 gameServer/ClientIO.hs
--- a/gameServer/ClientIO.hs	Wed Feb 02 09:05:48 2011 +0100
+++ b/gameServer/ClientIO.hs	Wed Feb 02 11:28:38 2011 +0300
@@ -1,4 +1,4 @@
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}
 module ClientIO where
 
 import qualified Control.Exception as Exception
@@ -6,45 +6,75 @@
 import Control.Concurrent
 import Control.Monad
 import System.IO
-import qualified Data.ByteString.UTF8 as BUTF8
-import qualified Data.ByteString as B
+import Network
+import Network.Socket.ByteString
+import qualified Data.ByteString.Char8 as B
 ----------------
 import CoreTypes
+import RoomsAndClients
+import Utils
 
-listenLoop :: Handle -> Int -> [String] -> Chan CoreMessage -> Int -> IO ()
-listenLoop handle linesNumber buf chan clientID = do
-    str <- liftM BUTF8.toString $ B.hGetLine handle
-    if (linesNumber > 50) || (length str > 20000) then
-        writeChan chan $ ClientMessage (clientID, ["QUIT", "Protocol violation"])
-        else
-        if str == "" then do
-            writeChan chan $ ClientMessage (clientID, buf)
-            yield
-            listenLoop handle 0 [] chan clientID
-            else
-            listenLoop handle (linesNumber + 1) (buf ++ [str]) chan clientID
+
+pDelim :: B.ByteString
+pDelim = B.pack "\n\n"
+
+bs2Packets :: B.ByteString -> ([[B.ByteString]], B.ByteString)
+bs2Packets buf = unfoldrE extractPackets buf
+    where
+    extractPackets :: B.ByteString -> Either B.ByteString ([B.ByteString], B.ByteString)
+    extractPackets buf = 
+        let buf' = until (not . B.isPrefixOf pDelim) (B.drop 2) buf in
+            let (bsPacket, bufTail) = B.breakSubstring pDelim buf' in
+                if B.null bufTail then
+                    Left bsPacket
+                    else
+                    if B.null bsPacket then 
+                        Left bufTail
+                        else
+                        Right (B.splitWith (== '\n') bsPacket, bufTail)
+
 
-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
+listenLoop :: Socket -> Chan CoreMessage -> ClientIndex -> IO ()
+listenLoop sock chan ci = recieveWithBufferLoop B.empty
+    where
+        recieveWithBufferLoop recvBuf = do
+            recvBS <- recv sock 4096
+--            putStrLn $ show sock ++ " got smth: " ++ (show $ B.length recvBS)
+            unless (B.null recvBS) $ do
+                let (packets, newrecvBuf) = bs2Packets $ B.append recvBuf recvBS
+                forM_ packets sendPacket
+                recieveWithBufferLoop newrecvBuf
+
+        sendPacket packet = writeChan chan $ ClientMessage (ci, packet)
 
-clientSendLoop :: Handle -> Chan CoreMessage -> Chan [String] -> Int -> IO()
-clientSendLoop handle coreChan chan clientID = do
+
+clientRecvLoop :: Socket -> Chan CoreMessage -> ClientIndex -> IO ()
+clientRecvLoop s chan ci = do
+    msg <- (listenLoop s chan ci >> return "Connection closed") `catch` (return . B.pack . show)
+    clientOff msg
+    where
+        clientOff msg = writeChan chan $ ClientMessage (ci, ["QUIT", msg])
+
+
+
+clientSendLoop :: Socket -> ThreadId -> Chan CoreMessage -> Chan [B.ByteString] -> ClientIndex -> IO ()
+clientSendLoop s tId coreChan chan ci = do
     answer <- readChan chan
-    doClose <- Exception.handle
-        (\(e :: Exception.IOException) -> if isQuit answer then return True else sendQuit e >> return False) $ do
-            B.hPutStrLn handle $ BUTF8.fromString $ unlines answer
-            hFlush handle
-            return $ isQuit answer
+    Exception.handle
+        (\(e :: Exception.IOException) -> when (not $ isQuit answer) $ sendQuit e) $ do
+            sendAll s $ (B.unlines answer) `B.append` (B.singleton '\n')
 
-    if doClose then
-        Exception.handle (\(_ :: Exception.IOException) -> putStrLn "error on hClose") $ hClose handle
+    if (isQuit answer) then
+        do
+        Exception.handle (\(_ :: Exception.IOException) -> putStrLn "error on sClose") $ sClose s
+        killThread tId
+        writeChan coreChan $ Remove ci
         else
-        clientSendLoop handle coreChan chan clientID
+        clientSendLoop s tId coreChan chan ci
 
     where
-        sendQuit e = writeChan coreChan $ ClientMessage (clientID, ["QUIT", show e])
+        sendQuit e = do
+            putStrLn $ show e
+            writeChan coreChan $ ClientMessage (ci, ["QUIT", B.pack $ show e])
         isQuit ("BYE":xs) = True
         isQuit _ = False