gameServer/Utils.hs
changeset 2952 18fada739b55
parent 2867 9be6693c78cb
child 3297 0c59b991007e
equal deleted inserted replaced
2951:c64d62afafef 2952:18fada739b55
    14 import qualified Data.List as List
    14 import qualified Data.List as List
    15 import Control.Monad
    15 import Control.Monad
    16 import Maybe
    16 import Maybe
    17 -------------------------------------------------
    17 -------------------------------------------------
    18 import qualified Codec.Binary.Base64 as Base64
    18 import qualified Codec.Binary.Base64 as Base64
    19 import qualified Codec.Binary.UTF8.String as UTF8
    19 import qualified Data.ByteString.UTF8 as BUTF8
       
    20 import qualified Data.ByteString as B
    20 import CoreTypes
    21 import CoreTypes
    21 
    22 
    22 
    23 
    23 sockAddr2String :: SockAddr -> IO String
    24 sockAddr2String :: SockAddr -> IO String
    24 sockAddr2String (SockAddrInet _ hostAddr) = inet_ntoa hostAddr
    25 sockAddr2String (SockAddrInet _ hostAddr) = inet_ntoa hostAddr
    26     return $ (foldr1 (.)
    27     return $ (foldr1 (.)
    27         $ List.intersperse (\a -> ':':a)
    28         $ List.intersperse (\a -> ':':a)
    28         $ concatMap (\n -> (\(a, b) -> [showHex a, showHex b]) $ divMod n 65536) [a, b, c, d]) []
    29         $ concatMap (\n -> (\(a, b) -> [showHex a, showHex b]) $ divMod n 65536) [a, b, c, d]) []
    29 
    30 
    30 toEngineMsg :: String -> String
    31 toEngineMsg :: String -> String
    31 toEngineMsg msg = Base64.encode (fromIntegral (length encodedMsg) : encodedMsg)
    32 toEngineMsg msg = Base64.encode (fromIntegral (B.length encodedMsg) : (B.unpack encodedMsg))
    32     where
    33     where
    33     encodedMsg = UTF8.encode msg
    34     encodedMsg = BUTF8.fromString msg
    34 
    35 
    35 fromEngineMsg :: String -> Maybe String
    36 fromEngineMsg :: String -> Maybe String
    36 fromEngineMsg msg = liftM (map w2c) (Base64.decode msg >>= removeLength)
    37 fromEngineMsg msg = liftM (map w2c) (Base64.decode msg >>= removeLength)
    37     where
    38     where
    38         removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing
    39         removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing