11 import Numeric |
12 import Numeric |
12 import Network.Socket |
13 import Network.Socket |
13 import System.IO |
14 import System.IO |
14 import qualified Data.List as List |
15 import qualified Data.List as List |
15 import Control.Monad |
16 import Control.Monad |
|
17 import Control.Monad.Trans |
16 import Data.Maybe |
18 import Data.Maybe |
17 ------------------------------------------------- |
19 ------------------------------------------------- |
18 import qualified Codec.Binary.Base64 as Base64 |
20 import qualified Codec.Binary.Base64 as Base64 |
19 import qualified Data.ByteString.UTF8 as BUTF8 |
21 import qualified Data.ByteString.Char8 as B |
20 import qualified Data.ByteString as B |
22 import qualified Data.ByteString as BW |
21 import CoreTypes |
23 import CoreTypes |
22 |
24 |
23 |
25 |
24 sockAddr2String :: SockAddr -> IO String |
26 sockAddr2String :: SockAddr -> IO B.ByteString |
25 sockAddr2String (SockAddrInet _ hostAddr) = inet_ntoa hostAddr |
27 sockAddr2String (SockAddrInet _ hostAddr) = liftM B.pack $ inet_ntoa hostAddr |
26 sockAddr2String (SockAddrInet6 _ _ (a, b, c, d) _) = |
28 sockAddr2String (SockAddrInet6 _ _ (a, b, c, d) _) = |
27 return $ (foldr1 (.) |
29 return $ B.pack $ (foldr1 (.) |
28 $ List.intersperse (\a -> ':':a) |
30 $ List.intersperse (\a -> ':':a) |
29 $ concatMap (\n -> (\(a, b) -> [showHex a, showHex b]) $ divMod n 65536) [a, b, c, d]) [] |
31 $ concatMap (\n -> (\(a, b) -> [showHex a, showHex b]) $ divMod n 65536) [a, b, c, d]) [] |
30 |
32 |
31 toEngineMsg :: String -> String |
33 toEngineMsg :: B.ByteString -> B.ByteString |
32 toEngineMsg msg = Base64.encode (fromIntegral (B.length encodedMsg) : (B.unpack encodedMsg)) |
34 toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : (BW.unpack msg)) |
33 where |
|
34 encodedMsg = BUTF8.fromString msg |
|
35 |
35 |
36 fromEngineMsg :: String -> Maybe String |
36 fromEngineMsg :: B.ByteString -> Maybe B.ByteString |
37 fromEngineMsg msg = liftM (map w2c) (Base64.decode msg >>= removeLength) |
37 fromEngineMsg msg = Base64.decode (B.unpack msg) >>= removeLength >>= return . BW.pack |
38 where |
38 where |
39 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 |
40 removeLength _ = Nothing |
40 removeLength _ = Nothing |
41 |
41 |
42 checkNetCmd :: String -> (Bool, Bool) |
42 checkNetCmd :: B.ByteString -> (Bool, Bool) |
43 checkNetCmd msg = check decoded |
43 checkNetCmd = check . liftM B.unpack . fromEngineMsg |
44 where |
44 where |
45 decoded = fromEngineMsg msg |
|
46 check Nothing = (False, False) |
45 check Nothing = (False, False) |
47 check (Just (m:ms)) = (m `Set.member` legalMessages, m == '+') |
46 check (Just (m:ms)) = (m `Set.member` legalMessages, m == '+') |
48 check _ = (False, False) |
47 check _ = (False, False) |
49 legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sFNpPwtghbc12345" ++ slotMessages |
48 legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sFNpPwtghb12345" ++ slotMessages |
50 slotMessages = "\128\129\130\131\132\133\134\135\136\137\138" |
49 slotMessages = "\128\129\130\131\132\133\134\135\136\137\138" |
51 |
50 |
52 maybeRead :: Read a => String -> Maybe a |
51 maybeRead :: Read a => String -> Maybe a |
53 maybeRead s = case reads s of |
52 maybeRead s = case reads s of |
54 [(x, rest)] | all isSpace rest -> Just x |
53 [(x, rest)] | all isSpace rest -> Just x |
55 _ -> Nothing |
54 _ -> Nothing |
56 |
55 |
57 teamToNet :: Word16 -> TeamInfo -> [String] |
56 teamToNet :: TeamInfo -> [B.ByteString] |
58 teamToNet protocol team |
57 teamToNet team = |
59 | protocol < 30 = [ |
58 "ADD_TEAM" |
60 "ADD_TEAM", |
59 : teamname team |
61 teamname team, |
60 : teamgrave team |
62 teamgrave team, |
61 : teamfort team |
63 teamfort team, |
62 : teamvoicepack team |
64 teamvoicepack team, |
63 : teamflag team |
65 teamowner team, |
64 : teamowner team |
66 show $ difficulty team |
65 : (B.pack $ show $ difficulty team) |
67 ] |
66 : hhsInfo |
68 ++ hhsInfo |
|
69 | otherwise = [ |
|
70 "ADD_TEAM", |
|
71 teamname team, |
|
72 teamgrave team, |
|
73 teamfort team, |
|
74 teamvoicepack team, |
|
75 teamflag team, |
|
76 teamowner team, |
|
77 show $ difficulty team |
|
78 ] |
|
79 ++ hhsInfo |
|
80 where |
67 where |
81 hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team |
68 hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team |
82 |
69 |
83 modifyTeam :: TeamInfo -> RoomInfo -> RoomInfo |
70 modifyTeam :: TeamInfo -> RoomInfo -> RoomInfo |
84 modifyTeam team room = room{teams = replaceTeam team $ teams room} |
71 modifyTeam team room = room{teams = replaceTeam team $ teams room} |
88 if teamname team == teamname t then |
75 if teamname team == teamname t then |
89 team : teams |
76 team : teams |
90 else |
77 else |
91 t : replaceTeam team teams |
78 t : replaceTeam team teams |
92 |
79 |
93 illegalName :: String -> Bool |
80 illegalName :: B.ByteString -> Bool |
94 illegalName s = null s || all isSpace s || isSpace (head s) || isSpace (last s) |
81 illegalName b = null s || all isSpace s || isSpace (head s) || isSpace (last s) |
|
82 where |
|
83 s = B.unpack b |
95 |
84 |
96 protoNumber2ver :: Word16 -> String |
85 protoNumber2ver :: Word16 -> B.ByteString |
97 protoNumber2ver 17 = "0.9.7-dev" |
86 protoNumber2ver v = Map.findWithDefault "Unknown" v vermap |
98 protoNumber2ver 19 = "0.9.7" |
87 where |
99 protoNumber2ver 20 = "0.9.8-dev" |
88 vermap = Map.fromList [ |
100 protoNumber2ver 21 = "0.9.8" |
89 (17, "0.9.7-dev"), |
101 protoNumber2ver 22 = "0.9.9-dev" |
90 (19, "0.9.7"), |
102 protoNumber2ver 23 = "0.9.9" |
91 (20, "0.9.8-dev"), |
103 protoNumber2ver 24 = "0.9.10-dev" |
92 (21, "0.9.8"), |
104 protoNumber2ver 25 = "0.9.10" |
93 (22, "0.9.9-dev"), |
105 protoNumber2ver 26 = "0.9.11-dev" |
94 (23, "0.9.9"), |
106 protoNumber2ver 27 = "0.9.11" |
95 (24, "0.9.10-dev"), |
107 protoNumber2ver 28 = "0.9.12-dev" |
96 (25, "0.9.10"), |
108 protoNumber2ver 29 = "0.9.12" |
97 (26, "0.9.11-dev"), |
109 protoNumber2ver 30 = "0.9.13-dev" |
98 (27, "0.9.11"), |
110 protoNumber2ver 31 = "0.9.13" |
99 (28, "0.9.12-dev"), |
111 protoNumber2ver 32 = "0.9.14-dev" |
100 (29, "0.9.12"), |
112 protoNumber2ver 33 = "0.9.14" |
101 (30, "0.9.13-dev"), |
113 protoNumber2ver 34 = "0.9.15-dev" |
102 (31, "0.9.13"), |
114 protoNumber2ver 35 = "0.9.14.1" |
103 (32, "0.9.14-dev"), |
115 protoNumber2ver 37 = "0.9.15" |
104 (33, "0.9.14"), |
116 protoNumber2ver 38 = "0.9.16-dev" |
105 (34, "0.9.15-dev"), |
117 protoNumber2ver w = show w |
106 (35, "0.9.14.1"), |
|
107 (37, "0.9.15"), |
|
108 (38, "0.9.16-dev")] |
118 |
109 |
119 askFromConsole :: String -> IO String |
110 askFromConsole :: String -> IO String |
120 askFromConsole msg = do |
111 askFromConsole msg = do |
121 putStr msg |
112 putStr msg |
122 hFlush stdout |
113 hFlush stdout |
123 getLine |
114 getLine |
|
115 |
|
116 |
|
117 unfoldrE :: (b -> Either b (a, b)) -> b -> ([a], b) |
|
118 unfoldrE f b = |
|
119 case f b of |
|
120 Right (a, new_b) -> let (a', b') = unfoldrE f new_b in (a : a', b') |
|
121 Left new_b -> ([], new_b) |
|
122 |
|
123 showB :: Show a => a -> B.ByteString |
|
124 showB = B.pack .show |