diff -r 66eba4e41b91 -r af8390d807d6 gameServer/Utils.hs --- a/gameServer/Utils.hs Sat Jun 05 20:49:51 2010 +0000 +++ b/gameServer/Utils.hs Sun Jun 06 15:29:33 2010 +0000 @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} module Utils where import Control.Concurrent @@ -16,33 +17,30 @@ import Maybe ------------------------------------------------- import qualified Codec.Binary.Base64 as Base64 -import qualified Data.ByteString.UTF8 as BUTF8 -import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString as BW import CoreTypes -sockAddr2String :: SockAddr -> IO String -sockAddr2String (SockAddrInet _ hostAddr) = inet_ntoa hostAddr +sockAddr2String :: SockAddr -> IO B.ByteString +sockAddr2String (SockAddrInet _ hostAddr) = liftM B.pack $ inet_ntoa hostAddr sockAddr2String (SockAddrInet6 _ _ (a, b, c, d) _) = - return $ (foldr1 (.) + return $ B.pack $ (foldr1 (.) $ List.intersperse (\a -> ':':a) $ concatMap (\n -> (\(a, b) -> [showHex a, showHex b]) $ divMod n 65536) [a, b, c, d]) [] -toEngineMsg :: String -> String -toEngineMsg msg = Base64.encode (fromIntegral (B.length encodedMsg) : (B.unpack encodedMsg)) - where - encodedMsg = BUTF8.fromString msg +toEngineMsg :: B.ByteString -> B.ByteString +toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : (BW.unpack msg)) -fromEngineMsg :: String -> Maybe String -fromEngineMsg msg = liftM (map w2c) (Base64.decode msg >>= removeLength) +fromEngineMsg :: B.ByteString -> Maybe B.ByteString +fromEngineMsg msg = Base64.decode (B.unpack msg) >>= removeLength >>= return . BW.pack where removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing removeLength _ = Nothing -checkNetCmd :: String -> (Bool, Bool) -checkNetCmd msg = check decoded +checkNetCmd :: B.ByteString -> (Bool, Bool) +checkNetCmd = check . liftM B.unpack . fromEngineMsg where - decoded = fromEngineMsg msg check Nothing = (False, False) check (Just (m:ms)) = (m `Set.member` legalMessages, m == '+') check _ = (False, False) @@ -54,29 +52,27 @@ [(x, rest)] | all isSpace rest -> Just x _ -> Nothing -teamToNet :: Word16 -> TeamInfo -> [String] +teamToNet :: Word16 -> TeamInfo -> [B.ByteString] teamToNet protocol team - | protocol < 30 = [ - "ADD_TEAM", - teamname team, - teamgrave team, - teamfort team, - teamvoicepack team, - teamowner team, - show $ difficulty team - ] - ++ hhsInfo - | otherwise = [ - "ADD_TEAM", - teamname team, - teamgrave team, - teamfort team, - teamvoicepack team, - teamflag team, - teamowner team, - show $ difficulty team - ] - ++ hhsInfo + | protocol < 30 = + "ADD_TEAM" + : teamname team + : teamgrave team + : teamfort team + : teamvoicepack team + : teamowner team + : (B.pack $ show $ difficulty team) + : hhsInfo + | otherwise = + "ADD_TEAM" + : teamname team + : teamgrave team + : teamfort team + : teamvoicepack team + : teamflag team + : teamowner team + : (B.pack $ show $ difficulty team) + : hhsInfo where hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team @@ -90,10 +86,10 @@ else t : replaceTeam team teams -illegalName :: String -> Bool -illegalName = all isSpace +illegalName :: B.ByteString -> Bool +illegalName = all isSpace . B.unpack -protoNumber2ver :: Word16 -> String +protoNumber2ver :: Word16 -> B.ByteString protoNumber2ver 17 = "0.9.7-dev" protoNumber2ver 19 = "0.9.7" protoNumber2ver 20 = "0.9.8-dev" @@ -116,3 +112,10 @@ putStr msg hFlush stdout getLine + + +unfoldrE :: (b -> Either b (a, b)) -> b -> ([a], b) +unfoldrE f b = + case f b of + Right (a, new_b) -> let (a', b') = unfoldrE f new_b in (a : a', b') + Left new_b -> ([], new_b)