gameServer/Utils.hs
changeset 4904 0eab727d4717
parent 4768 d00562929f28
parent 4601 08ae94dd4c0d
child 4921 2efad3acbb74
--- 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