- Convert strings from utf-8 on recieve, and back to utf-8 when send them
- Optimize send by using 'unlines' function
- not tested
--- a/gameServer/ClientIO.hs Sat Mar 06 13:39:50 2010 +0000
+++ b/gameServer/ClientIO.hs Sat Mar 06 13:40:40 2010 +0000
@@ -6,12 +6,14 @@
import Control.Concurrent
import Control.Monad
import System.IO
+import qualified Data.ByteString.UTF8 as BUTF8
+import qualified Data.ByteString as B
----------------
import CoreTypes
listenLoop :: Handle -> Int -> [String] -> Chan CoreMessage -> Int -> IO ()
listenLoop handle linesNumber buf chan clientID = do
- str <- hGetLine handle
+ str <- liftM BUTF8.toString $ B.hGetLine handle
if (linesNumber > 50) || (length str > 450) then
writeChan chan $ ClientMessage (clientID, ["QUIT", "Protocol violation"])
else
@@ -33,8 +35,7 @@
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 ""
+ B.hPutStrLn handle $ BUTF8.fromString $ unlines (answer ++ [""])
hFlush handle
return $ isQuit answer
--- a/gameServer/HWProtoInRoomState.hs Sat Mar 06 13:39:50 2010 +0000
+++ b/gameServer/HWProtoInRoomState.hs Sat Mar 06 13:40:40 2010 +0000
@@ -6,7 +6,6 @@
import Data.Sequence(Seq, (|>), (><), fromList, empty)
import Data.List
import Maybe
-import qualified Codec.Binary.UTF8.String as UTF8
--------------------------------------
import CoreTypes
import Actions
@@ -202,10 +201,6 @@
[]
where
client = clients IntMap.! clID
- -- FIXME: why are those decoded* function used?
- -- it would be better to use ByteString instead of String
- engineMsg = toEngineMsg $ 'b' : (decodedNick ++ "(team): " ++ decodedMsg ++ "\x20\x20")
- decodedMsg = UTF8.decodeString msg
- decodedNick = UTF8.decodeString $ nick client
+ engineMsg = toEngineMsg $ 'b' : ((nick client) ++ "(team): " ++ msg ++ "\x20\x20")
handleCmd_inRoom clID _ _ _ = [ProtocolError "Incorrect command (state: in room)"]
--- a/gameServer/Utils.hs Sat Mar 06 13:39:50 2010 +0000
+++ b/gameServer/Utils.hs Sat Mar 06 13:40:40 2010 +0000
@@ -16,7 +16,8 @@
import Maybe
-------------------------------------------------
import qualified Codec.Binary.Base64 as Base64
-import qualified Codec.Binary.UTF8.String as UTF8
+import qualified Data.ByteString.UTF8 as BUTF8
+import qualified Data.ByteString as B
import CoreTypes
@@ -28,9 +29,9 @@
$ concatMap (\n -> (\(a, b) -> [showHex a, showHex b]) $ divMod n 65536) [a, b, c, d]) []
toEngineMsg :: String -> String
-toEngineMsg msg = Base64.encode (fromIntegral (length encodedMsg) : encodedMsg)
+toEngineMsg msg = Base64.encode (fromIntegral (B.length encodedMsg) : (B.unpack encodedMsg))
where
- encodedMsg = UTF8.encode msg
+ encodedMsg = BUTF8.fromString msg
fromEngineMsg :: String -> Maybe String
fromEngineMsg msg = liftM (map w2c) (Base64.decode msg >>= removeLength)