author  unc0rr 
Mon, 24 Jan 2011 21:32:26 +0300  
branch  server_refactor 
changeset 4581  af2e231bd9be 
parent 4569  a835465b4fd2 
child 4583  ab82045ea083 
permissions  rwrr 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

1 
{# LANGUAGE OverloadedStrings #} 
1804  2 
module Utils where 
3 

4 
import Control.Concurrent 

5 
import Control.Concurrent.STM 

6 
import Data.Char 

7 
import Data.Word 

8 
import qualified Data.Map as Map 

9 
import qualified Data.IntMap as IntMap 

2304  10 
import qualified Data.Set as Set 
2310  11 
import Data.ByteString.Internal (w2c) 
1917  12 
import Numeric 
13 
import Network.Socket 

1964  14 
import System.IO 
1917  15 
import qualified Data.List as List 
2349  16 
import Control.Monad 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

17 
import Data.Maybe 
1804  18 
 
19 
import qualified Codec.Binary.Base64 as Base64 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

20 
import qualified Data.ByteString.Char8 as B 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

21 
import qualified Data.ByteString as BW 
1804  22 
import CoreTypes 
23 

1917  24 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

25 
sockAddr2String :: SockAddr > IO B.ByteString 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

26 
sockAddr2String (SockAddrInet _ hostAddr) = liftM B.pack $ inet_ntoa hostAddr 
1917  27 
sockAddr2String (SockAddrInet6 _ _ (a, b, c, d) _) = 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

28 
return $ B.pack $ (foldr1 (.) 
2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

29 
$ List.intersperse (\a > ':':a) 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

30 
$ concatMap (\n > (\(a, b) > [showHex a, showHex b]) $ divMod n 65536) [a, b, c, d]) [] 
1917  31 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

32 
toEngineMsg :: B.ByteString > B.ByteString 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

33 
toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : (BW.unpack msg)) 
1804  34 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

35 
fromEngineMsg :: B.ByteString > Maybe B.ByteString 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

36 
fromEngineMsg msg = Base64.decode (B.unpack msg) >>= removeLength >>= return . BW.pack 
2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

37 
where 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

38 
removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

39 
removeLength _ = Nothing 
2304  40 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

41 
checkNetCmd :: B.ByteString > (Bool, Bool) 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

42 
checkNetCmd = check . liftM B.unpack . fromEngineMsg 
2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

43 
where 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

44 
check Nothing = (False, False) 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

45 
check (Just (m:ms)) = (m `Set.member` legalMessages, m == '+') 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

46 
check _ = (False, False) 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

47 
legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sFNpPwtghb12345" ++ slotMessages 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

48 
slotMessages = "\128\129\130\131\132\133\134\135\136\137\138" 
1804  49 

50 
maybeRead :: Read a => String > Maybe a 

51 
maybeRead s = case reads s of 

2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

52 
[(x, rest)]  all isSpace rest > Just x 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

53 
_ > Nothing 
1804  54 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

55 
teamToNet :: TeamInfo > [B.ByteString] 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

56 
teamToNet team = 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

57 
"ADD_TEAM" 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

58 
: teamname team 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

59 
: teamgrave team 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

60 
: teamfort team 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

61 
: teamvoicepack team 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

62 
: teamflag team 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

63 
: teamowner team 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

64 
: (B.pack $ show $ difficulty team) 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

65 
: hhsInfo 
2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

66 
where 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

67 
hhsInfo = concatMap (\(HedgehogInfo name hat) > [name, hat]) $ hedgehogs team 
1804  68 

69 
modifyTeam :: TeamInfo > RoomInfo > RoomInfo 

70 
modifyTeam team room = room{teams = replaceTeam team $ teams room} 

2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

71 
where 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

72 
replaceTeam _ [] = error "modifyTeam: no such team" 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

73 
replaceTeam team (t:teams) = 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

74 
if teamname team == teamname t then 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

75 
team : teams 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

76 
else 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

77 
t : replaceTeam team teams 
1804  78 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

79 
illegalName :: B.ByteString > Bool 
4581  80 
illegalName b = null s  all isSpace s  isSpace (head s)  isSpace (last s) 
81 
where 

82 
s = B.unpack b 

2150
45b695f3a7b9
Forbid room names and nicknames consisting only of space characters
unc0rr
parents:
2113
diff
changeset

83 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

84 
protoNumber2ver :: Word16 > B.ByteString 
4569  85 
protoNumber2ver v = Map.findWithDefault "Unknown" v vermap 
86 
where 

87 
vermap = Map.fromList [ 

88 
(17, "0.9.7dev"), 

89 
(19, "0.9.7"), 

90 
(20, "0.9.8dev"), 

91 
(21, "0.9.8"), 

92 
(22, "0.9.9dev"), 

93 
(23, "0.9.9"), 

94 
(24, "0.9.10dev"), 

95 
(25, "0.9.10"), 

96 
(26, "0.9.11dev"), 

97 
(27, "0.9.11"), 

98 
(28, "0.9.12dev"), 

99 
(29, "0.9.12"), 

100 
(30, "0.9.13dev"), 

101 
(31, "0.9.13"), 

102 
(32, "0.9.14dev"), 

103 
(33, "0.9.14"), 

104 
(34, "0.9.15dev"), 

105 
(35, "0.9.14.1"), 

106 
(37, "0.9.15"), 

107 
(38, "0.9.15dev")] 

1804  108 

1964  109 
askFromConsole :: String > IO String 
110 
askFromConsole msg = do 

2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

111 
putStr msg 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

112 
hFlush stdout 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

113 
getLine 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

114 

1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

115 

1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

116 
unfoldrE :: (b > Either b (a, b)) > b > ([a], b) 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

117 
unfoldrE f b = 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

118 
case f b of 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

119 
Right (a, new_b) > let (a', b') = unfoldrE f new_b in (a : a', b') 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

120 
Left new_b > ([], new_b) 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

121 

1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

122 
showB :: Show a => a > B.ByteString 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

123 
showB = B.pack .show 