14 import qualified Data.List as List |
15 import qualified Data.List as List |
15 import Control.Monad |
16 import Control.Monad |
16 import Maybe |
17 import Maybe |
17 ------------------------------------------------- |
18 ------------------------------------------------- |
18 import qualified Codec.Binary.Base64 as Base64 |
19 import qualified Codec.Binary.Base64 as Base64 |
19 import qualified Data.ByteString.UTF8 as BUTF8 |
20 import qualified Data.ByteString.Char8 as B |
20 import qualified Data.ByteString as B |
21 import qualified Data.ByteString as BW |
21 import CoreTypes |
22 import CoreTypes |
22 |
23 |
23 |
24 |
24 sockAddr2String :: SockAddr -> IO String |
25 sockAddr2String :: SockAddr -> IO B.ByteString |
25 sockAddr2String (SockAddrInet _ hostAddr) = inet_ntoa hostAddr |
26 sockAddr2String (SockAddrInet _ hostAddr) = liftM B.pack $ inet_ntoa hostAddr |
26 sockAddr2String (SockAddrInet6 _ _ (a, b, c, d) _) = |
27 sockAddr2String (SockAddrInet6 _ _ (a, b, c, d) _) = |
27 return $ (foldr1 (.) |
28 return $ B.pack $ (foldr1 (.) |
28 $ List.intersperse (\a -> ':':a) |
29 $ List.intersperse (\a -> ':':a) |
29 $ concatMap (\n -> (\(a, b) -> [showHex a, showHex b]) $ divMod n 65536) [a, b, c, d]) [] |
30 $ concatMap (\n -> (\(a, b) -> [showHex a, showHex b]) $ divMod n 65536) [a, b, c, d]) [] |
30 |
31 |
31 toEngineMsg :: String -> String |
32 toEngineMsg :: B.ByteString -> B.ByteString |
32 toEngineMsg msg = Base64.encode (fromIntegral (B.length encodedMsg) : (B.unpack encodedMsg)) |
33 toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : (BW.unpack msg)) |
33 where |
|
34 encodedMsg = BUTF8.fromString msg |
|
35 |
34 |
36 fromEngineMsg :: String -> Maybe String |
35 fromEngineMsg :: B.ByteString -> Maybe B.ByteString |
37 fromEngineMsg msg = liftM (map w2c) (Base64.decode msg >>= removeLength) |
36 fromEngineMsg msg = Base64.decode (B.unpack msg) >>= removeLength >>= return . BW.pack |
38 where |
37 where |
39 removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing |
38 removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing |
40 removeLength _ = Nothing |
39 removeLength _ = Nothing |
41 |
40 |
42 checkNetCmd :: String -> (Bool, Bool) |
41 checkNetCmd :: B.ByteString -> (Bool, Bool) |
43 checkNetCmd msg = check decoded |
42 checkNetCmd = check . liftM B.unpack . fromEngineMsg |
44 where |
43 where |
45 decoded = fromEngineMsg msg |
|
46 check Nothing = (False, False) |
44 check Nothing = (False, False) |
47 check (Just (m:ms)) = (m `Set.member` legalMessages, m == '+') |
45 check (Just (m:ms)) = (m `Set.member` legalMessages, m == '+') |
48 check _ = (False, False) |
46 check _ = (False, False) |
49 legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sFNpPwtghb12345" ++ slotMessages |
47 legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sFNpPwtghb12345" ++ slotMessages |
50 slotMessages = "\128\129\130\131\132\133\134\135\136\137\138" |
48 slotMessages = "\128\129\130\131\132\133\134\135\136\137\138" |
52 maybeRead :: Read a => String -> Maybe a |
50 maybeRead :: Read a => String -> Maybe a |
53 maybeRead s = case reads s of |
51 maybeRead s = case reads s of |
54 [(x, rest)] | all isSpace rest -> Just x |
52 [(x, rest)] | all isSpace rest -> Just x |
55 _ -> Nothing |
53 _ -> Nothing |
56 |
54 |
57 teamToNet :: Word16 -> TeamInfo -> [String] |
55 teamToNet :: Word16 -> TeamInfo -> [B.ByteString] |
58 teamToNet protocol team |
56 teamToNet protocol team |
59 | protocol < 30 = [ |
57 | protocol < 30 = |
60 "ADD_TEAM", |
58 "ADD_TEAM" |
61 teamname team, |
59 : teamname team |
62 teamgrave team, |
60 : teamgrave team |
63 teamfort team, |
61 : teamfort team |
64 teamvoicepack team, |
62 : teamvoicepack team |
65 teamowner team, |
63 : teamowner team |
66 show $ difficulty team |
64 : (B.pack $ show $ difficulty team) |
67 ] |
65 : hhsInfo |
68 ++ hhsInfo |
66 | otherwise = |
69 | otherwise = [ |
67 "ADD_TEAM" |
70 "ADD_TEAM", |
68 : teamname team |
71 teamname team, |
69 : teamgrave team |
72 teamgrave team, |
70 : teamfort team |
73 teamfort team, |
71 : teamvoicepack team |
74 teamvoicepack team, |
72 : teamflag team |
75 teamflag team, |
73 : teamowner team |
76 teamowner team, |
74 : (B.pack $ show $ difficulty team) |
77 show $ difficulty team |
75 : hhsInfo |
78 ] |
|
79 ++ hhsInfo |
|
80 where |
76 where |
81 hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team |
77 hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team |
82 |
78 |
83 modifyTeam :: TeamInfo -> RoomInfo -> RoomInfo |
79 modifyTeam :: TeamInfo -> RoomInfo -> RoomInfo |
84 modifyTeam team room = room{teams = replaceTeam team $ teams room} |
80 modifyTeam team room = room{teams = replaceTeam team $ teams room} |
88 if teamname team == teamname t then |
84 if teamname team == teamname t then |
89 team : teams |
85 team : teams |
90 else |
86 else |
91 t : replaceTeam team teams |
87 t : replaceTeam team teams |
92 |
88 |
93 illegalName :: String -> Bool |
89 illegalName :: B.ByteString -> Bool |
94 illegalName = all isSpace |
90 illegalName = all isSpace . B.unpack |
95 |
91 |
96 protoNumber2ver :: Word16 -> String |
92 protoNumber2ver :: Word16 -> B.ByteString |
97 protoNumber2ver 17 = "0.9.7-dev" |
93 protoNumber2ver 17 = "0.9.7-dev" |
98 protoNumber2ver 19 = "0.9.7" |
94 protoNumber2ver 19 = "0.9.7" |
99 protoNumber2ver 20 = "0.9.8-dev" |
95 protoNumber2ver 20 = "0.9.8-dev" |
100 protoNumber2ver 21 = "0.9.8" |
96 protoNumber2ver 21 = "0.9.8" |
101 protoNumber2ver 22 = "0.9.9-dev" |
97 protoNumber2ver 22 = "0.9.9-dev" |