--- a/gameServer/ClientIO.hs	Sat Jun 05 20:49:51 2010 +0000
+++ b/gameServer/ClientIO.hs	Sun Jun 06 15:29:33 2010 +0000
@@ -1,4 +1,4 @@
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-}
 module ClientIO where
 
 import qualified Control.Exception as Exception
@@ -6,53 +6,71 @@
 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
-
-listenLoop :: Handle -> Int -> [String] -> Chan CoreMessage -> ClientIndex -> IO ()
-listenLoop handle linesNumber buf chan clientID = do
-    putStrLn $ show handle ++ show buf ++ show clientID
-    str <- liftM BUTF8.toString $ B.hGetLine handle
-    if (linesNumber > 50) || (length str > 450) then
-           protocolViolationMsg >> freeClient
-        else
-        if str == "" then do
-            writeChan chan $ ClientMessage (clientID, reverse buf)
-            yield
-            listenLoop handle 0 [] chan clientID
-            else
-            listenLoop handle (linesNumber + 1) (str : buf) chan clientID
-    where 
-        protocolViolationMsg = writeChan chan $ ClientMessage (clientID, ["QUIT", "Protocol violation"])
-        freeClient = writeChan chan $ FreeClient clientID
+import Utils
 
 
-clientRecvLoop :: Handle -> Chan CoreMessage -> ClientIndex -> IO ()
-clientRecvLoop handle chan clientID =
-    listenLoop handle 0 [] chan clientID
-        `catch` (\e -> clientOff (show e) >> freeClient >> return ())
+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)
+                   
+
+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)
+
+
+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 (clientID, ["QUIT", msg]) -- if the client disconnects, we perform as if it sent QUIT message
-        freeClient = writeChan chan $ FreeClient clientID
+        clientOff msg = writeChan chan $ ClientMessage (ci, ["QUIT", msg])
+
 
-clientSendLoop :: Handle -> Chan CoreMessage -> Chan [String] -> ClientIndex -> IO()
-clientSendLoop handle coreChan chan clientID = do
+
+clientSendLoop :: Socket -> Chan CoreMessage -> Chan [B.ByteString] -> ClientIndex -> IO()
+clientSendLoop s 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
+            sendAll s $ (B.unlines answer) `B.append` (B.singleton '\n')
             return $ isQuit answer
 
     if doClose then
-        Exception.handle (\(_ :: Exception.IOException) -> putStrLn "error on hClose") $ hClose handle
+        Exception.handle (\(_ :: Exception.IOException) -> putStrLn "error on sClose") $ sClose s
         else
-        clientSendLoop handle coreChan chan clientID
+        clientSendLoop s coreChan chan ci
 
     where
-        sendQuit e = writeChan coreChan $ ClientMessage (clientID, ["QUIT", show e])
+        sendQuit e = writeChan coreChan $ ClientMessage (ci, ["QUIT", B.pack $ show e])
         isQuit ("BYE":xs) = True
         isQuit _ = False