diff -r 21dd1def5aaf -r 0eab727d4717 gameServer/Utils.hs --- a/gameServer/Utils.hs Wed Feb 02 09:05:48 2011 +0100 +++ b/gameServer/Utils.hs Wed Feb 02 11:28:38 2011 +0300 @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} module Utils where import Control.Concurrent @@ -13,40 +14,38 @@ import System.IO import qualified Data.List as List import Control.Monad +import Control.Monad.Trans import Data.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) - legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sFNpPwtghbc12345" ++ slotMessages + legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sFNpPwtghb12345" ++ slotMessages slotMessages = "\128\129\130\131\132\133\134\135\136\137\138" maybeRead :: Read a => String -> Maybe a @@ -54,29 +53,17 @@ [(x, rest)] | all isSpace rest -> Just x _ -> Nothing -teamToNet :: Word16 -> TeamInfo -> [String] -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 +teamToNet :: TeamInfo -> [B.ByteString] +teamToNet team = + "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,34 +77,48 @@ else t : replaceTeam team teams -illegalName :: String -> Bool -illegalName s = null s || all isSpace s || isSpace (head s) || isSpace (last s) +illegalName :: B.ByteString -> Bool +illegalName b = null s || all isSpace s || isSpace (head s) || isSpace (last s) + where + s = B.unpack b -protoNumber2ver :: Word16 -> String -protoNumber2ver 17 = "0.9.7-dev" -protoNumber2ver 19 = "0.9.7" -protoNumber2ver 20 = "0.9.8-dev" -protoNumber2ver 21 = "0.9.8" -protoNumber2ver 22 = "0.9.9-dev" -protoNumber2ver 23 = "0.9.9" -protoNumber2ver 24 = "0.9.10-dev" -protoNumber2ver 25 = "0.9.10" -protoNumber2ver 26 = "0.9.11-dev" -protoNumber2ver 27 = "0.9.11" -protoNumber2ver 28 = "0.9.12-dev" -protoNumber2ver 29 = "0.9.12" -protoNumber2ver 30 = "0.9.13-dev" -protoNumber2ver 31 = "0.9.13" -protoNumber2ver 32 = "0.9.14-dev" -protoNumber2ver 33 = "0.9.14" -protoNumber2ver 34 = "0.9.15-dev" -protoNumber2ver 35 = "0.9.14.1" -protoNumber2ver 37 = "0.9.15" -protoNumber2ver 38 = "0.9.16-dev" -protoNumber2ver w = show w +protoNumber2ver :: Word16 -> B.ByteString +protoNumber2ver v = Map.findWithDefault "Unknown" v vermap + where + vermap = Map.fromList [ + (17, "0.9.7-dev"), + (19, "0.9.7"), + (20, "0.9.8-dev"), + (21, "0.9.8"), + (22, "0.9.9-dev"), + (23, "0.9.9"), + (24, "0.9.10-dev"), + (25, "0.9.10"), + (26, "0.9.11-dev"), + (27, "0.9.11"), + (28, "0.9.12-dev"), + (29, "0.9.12"), + (30, "0.9.13-dev"), + (31, "0.9.13"), + (32, "0.9.14-dev"), + (33, "0.9.14"), + (34, "0.9.15-dev"), + (35, "0.9.14.1"), + (37, "0.9.15"), + (38, "0.9.16-dev")] askFromConsole :: String -> IO String askFromConsole msg = do 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) + +showB :: Show a => a -> B.ByteString +showB = B.pack .show