- Convert strings from utf-8 on recieve, and back to utf-8 when send them
authorunc0rr
Sat, 06 Mar 2010 13:40:40 +0000
changeset 2952 18fada739b55
parent 2951 c64d62afafef
child 2953 098eaa7fd88b
- Convert strings from utf-8 on recieve, and back to utf-8 when send them - Optimize send by using 'unlines' function - not tested
gameServer/ClientIO.hs
gameServer/HWProtoInRoomState.hs
gameServer/Utils.hs
--- 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)