author  unc0rr 
Sat, 05 Feb 2011 23:15:22 +0300  
changeset 4921  2efad3acbb74 
parent 4904  0eab727d4717 
child 4932  f11d80bac7ed 
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 
4601  17 
import Control.Monad.Trans 
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

18 
import Data.Maybe 
1804  19 
 
20 
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

21 
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

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

1917  25 

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

26 
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

27 
sockAddr2String (SockAddrInet _ hostAddr) = liftM B.pack $ inet_ntoa hostAddr 
1917  28 
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

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

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

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

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

33 
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

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

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

36 
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

37 
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

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

39 
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

40 
removeLength _ = Nothing 
2304  41 

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

42 
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

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

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

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

46 
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

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

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

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

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

52 
maybeRead s = case reads s of 

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

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

54 
_ > Nothing 
1804  55 

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

56 
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

57 
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

58 
"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

59 
: 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

60 
: 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

61 
: 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

62 
: 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

63 
: 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

64 
: 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

65 
: (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

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

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

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

70 
modifyTeam :: TeamInfo > RoomInfo > RoomInfo 

71 
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

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

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

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

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

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

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

78 
t : replaceTeam team teams 
1804  79 

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

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

83 
s = B.unpack b 

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

84 

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

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

88 
vermap = Map.fromList [ 

89 
(17, "0.9.7dev"), 

90 
(19, "0.9.7"), 

91 
(20, "0.9.8dev"), 

92 
(21, "0.9.8"), 

93 
(22, "0.9.9dev"), 

94 
(23, "0.9.9"), 

95 
(24, "0.9.10dev"), 

96 
(25, "0.9.10"), 

97 
(26, "0.9.11dev"), 

98 
(27, "0.9.11"), 

99 
(28, "0.9.12dev"), 

100 
(29, "0.9.12"), 

101 
(30, "0.9.13dev"), 

102 
(31, "0.9.13"), 

103 
(32, "0.9.14dev"), 

104 
(33, "0.9.14"), 

105 
(34, "0.9.15dev"), 

106 
(35, "0.9.14.1"), 

107 
(37, "0.9.15"), 

4583  108 
(38, "0.9.16dev")] 
1804  109 

4921  110 
askFromConsole :: B.ByteString > IO B.ByteString 
1964  111 
askFromConsole msg = do 
4921  112 
B.putStr msg 
2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

113 
hFlush stdout 
4921  114 
B.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

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 

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 :: (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

118 
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

119 
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

120 
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

121 
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

122 

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 :: 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

124 
showB = B.pack .show 