1 {-# LANGUAGE OverloadedStrings #-} |
1 {-# LANGUAGE OverloadedStrings #-} |
2 module Utils where |
2 module Utils where |
3 |
3 |
4 import Control.Concurrent |
|
5 import Control.Concurrent.STM |
|
6 import Data.Char |
4 import Data.Char |
7 import Data.Word |
5 import Data.Word |
8 import qualified Data.Map as Map |
6 import qualified Data.Map as Map |
9 import qualified Data.IntMap as IntMap |
|
10 import qualified Data.Set as Set |
7 import qualified Data.Set as Set |
11 import Data.ByteString.Internal (w2c) |
|
12 import Numeric |
8 import Numeric |
13 import Network.Socket |
9 import Network.Socket |
14 import System.IO |
10 import System.IO |
15 import qualified Data.List as List |
11 import qualified Data.List as List |
16 import Control.Monad |
12 import Control.Monad |
17 import Control.Monad.Trans |
|
18 import Data.Maybe |
|
19 ------------------------------------------------- |
13 ------------------------------------------------- |
20 import qualified Codec.Binary.Base64 as Base64 |
14 import qualified Codec.Binary.Base64 as Base64 |
21 import qualified Data.ByteString.Char8 as B |
15 import qualified Data.ByteString.Char8 as B |
22 import qualified Data.ByteString as BW |
16 import qualified Data.ByteString as BW |
23 import CoreTypes |
17 import CoreTypes |
25 |
19 |
26 sockAddr2String :: SockAddr -> IO B.ByteString |
20 sockAddr2String :: SockAddr -> IO B.ByteString |
27 sockAddr2String (SockAddrInet _ hostAddr) = liftM B.pack $ inet_ntoa hostAddr |
21 sockAddr2String (SockAddrInet _ hostAddr) = liftM B.pack $ inet_ntoa hostAddr |
28 sockAddr2String (SockAddrInet6 _ _ (a, b, c, d) _) = |
22 sockAddr2String (SockAddrInet6 _ _ (a, b, c, d) _) = |
29 return $ B.pack $ (foldr1 (.) |
23 return $ B.pack $ (foldr1 (.) |
30 $ List.intersperse (\a -> ':':a) |
24 $ List.intersperse (':':) |
31 $ concatMap (\n -> (\(a, b) -> [showHex a, showHex b]) $ divMod n 65536) [a, b, c, d]) [] |
25 $ concatMap (\n -> (\(a0, a1) -> [showHex a0, showHex a1]) $ divMod n 65536) [a, b, c, d]) [] |
32 |
26 |
33 toEngineMsg :: B.ByteString -> B.ByteString |
27 toEngineMsg :: B.ByteString -> B.ByteString |
34 toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : (BW.unpack msg)) |
28 toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : BW.unpack msg) |
35 |
29 |
36 fromEngineMsg :: B.ByteString -> Maybe B.ByteString |
30 fromEngineMsg :: B.ByteString -> Maybe B.ByteString |
37 fromEngineMsg msg = Base64.decode (B.unpack msg) >>= removeLength >>= return . BW.pack |
31 fromEngineMsg msg = liftM BW.pack (Base64.decode (B.unpack msg) >>= removeLength) |
38 where |
32 where |
39 removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing |
33 removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing |
40 removeLength _ = Nothing |
34 removeLength _ = Nothing |
41 |
35 |
42 checkNetCmd :: B.ByteString -> (Bool, Bool) |
36 checkNetCmd :: B.ByteString -> (Bool, Bool) |
43 checkNetCmd = check . liftM B.unpack . fromEngineMsg |
37 checkNetCmd = check . liftM B.unpack . fromEngineMsg |
44 where |
38 where |
45 check Nothing = (False, False) |
39 check Nothing = (False, False) |
46 check (Just (m:ms)) = (m `Set.member` legalMessages, m == '+') |
40 check (Just (m:_)) = (m `Set.member` legalMessages, m == '+') |
47 check _ = (False, False) |
41 check _ = (False, False) |
48 legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sFNpPwtghb12345" ++ slotMessages |
42 legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sFNpPwtghb12345" ++ slotMessages |
49 slotMessages = "\128\129\130\131\132\133\134\135\136\137\138" |
43 slotMessages = "\128\129\130\131\132\133\134\135\136\137\138" |
50 |
44 |
51 maybeRead :: Read a => String -> Maybe a |
45 maybeRead :: Read a => String -> Maybe a |
60 : teamgrave team |
54 : teamgrave team |
61 : teamfort team |
55 : teamfort team |
62 : teamvoicepack team |
56 : teamvoicepack team |
63 : teamflag team |
57 : teamflag team |
64 : teamowner team |
58 : teamowner team |
65 : (B.pack $ show $ difficulty team) |
59 : (B.pack . show $ difficulty team) |
66 : hhsInfo |
60 : hhsInfo |
67 where |
61 where |
68 hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team |
62 hhsInfo = concatMap (\(HedgehogInfo n hat) -> [n, hat]) $ hedgehogs team |
69 |
63 |
70 modifyTeam :: TeamInfo -> RoomInfo -> RoomInfo |
64 modifyTeam :: TeamInfo -> RoomInfo -> RoomInfo |
71 modifyTeam team room = room{teams = replaceTeam team $ teams room} |
65 modifyTeam team room = room{teams = replaceTeam team $ teams room} |
72 where |
66 where |
73 replaceTeam _ [] = error "modifyTeam: no such team" |
67 replaceTeam _ [] = error "modifyTeam: no such team" |
74 replaceTeam team (t:teams) = |
68 replaceTeam tm (t:ts) = |
75 if teamname team == teamname t then |
69 if teamname tm == teamname t then |
76 team : teams |
70 tm : ts |
77 else |
71 else |
78 t : replaceTeam team teams |
72 t : replaceTeam tm ts |
79 |
73 |
80 illegalName :: B.ByteString -> Bool |
74 illegalName :: B.ByteString -> Bool |
81 illegalName b = null s || all isSpace s || isSpace (head s) || isSpace (last s) |
75 illegalName b = null s || all isSpace s || isSpace (head s) || isSpace (last s) |
82 where |
76 where |
83 s = B.unpack b |
77 s = B.unpack b |