author  unc0rr 
Sun, 06 Feb 2011 21:50:29 +0300  
changeset 4932  f11d80bac7ed 
parent 4921  2efad3acbb74 
child 4936  d65d438acd23 
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 Data.Char 

5 
import Data.Word 

6 
import qualified Data.Map as Map 

2304  7 
import qualified Data.Set as Set 
1917  8 
import Numeric 
9 
import Network.Socket 

1964  10 
import System.IO 
1917  11 
import qualified Data.List as List 
2349  12 
import Control.Monad 
1804  13 
 
14 
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

15 
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

16 
import qualified Data.ByteString as BW 
1804  17 
import CoreTypes 
18 

1917  19 

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

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

23 
return $ B.pack $ (foldr1 (.) 
4932  24 
$ List.intersperse (':':) 
25 
$ concatMap (\n > (\(a0, a1) > [showHex a0, showHex a1]) $ divMod n 65536) [a, b, c, d]) [] 

1917  26 

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

27 
toEngineMsg :: B.ByteString > B.ByteString 
4932  28 
toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : BW.unpack msg) 
1804  29 

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

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

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

33 
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

34 
removeLength _ = Nothing 
2304  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 
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

37 
checkNetCmd = check . liftM B.unpack . fromEngineMsg 
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 
check Nothing = (False, False) 
4932  40 
check (Just (m:_)) = (m `Set.member` legalMessages, m == '+') 
2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2747
diff
changeset

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

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

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

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

46 
maybeRead s = case reads s of 

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

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

48 
_ > Nothing 
1804  49 

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

50 
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

51 
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

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

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

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

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

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

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

58 
: teamowner team 
4932  59 
: (B.pack . show $ difficulty team) 
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

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

61 
where 
4932  62 
hhsInfo = concatMap (\(HedgehogInfo n hat) > [n, hat]) $ hedgehogs team 
1804  63 

64 
modifyTeam :: TeamInfo > RoomInfo > RoomInfo 

65 
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

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

67 
replaceTeam _ [] = error "modifyTeam: no such team" 
4932  68 
replaceTeam tm (t:ts) = 
69 
if teamname tm == teamname t then 

70 
tm : ts 

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

71 
else 
4932  72 
t : replaceTeam tm ts 
1804  73 

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

74 
illegalName :: B.ByteString > Bool 
4581  75 
illegalName b = null s  all isSpace s  isSpace (head s)  isSpace (last s) 
76 
where 

77 
s = B.unpack b 

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

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 
protoNumber2ver :: Word16 > B.ByteString 
4569  80 
protoNumber2ver v = Map.findWithDefault "Unknown" v vermap 
81 
where 

82 
vermap = Map.fromList [ 

83 
(17, "0.9.7dev"), 

84 
(19, "0.9.7"), 

85 
(20, "0.9.8dev"), 

86 
(21, "0.9.8"), 

87 
(22, "0.9.9dev"), 

88 
(23, "0.9.9"), 

89 
(24, "0.9.10dev"), 

90 
(25, "0.9.10"), 

91 
(26, "0.9.11dev"), 

92 
(27, "0.9.11"), 

93 
(28, "0.9.12dev"), 

94 
(29, "0.9.12"), 

95 
(30, "0.9.13dev"), 

96 
(31, "0.9.13"), 

97 
(32, "0.9.14dev"), 

98 
(33, "0.9.14"), 

99 
(34, "0.9.15dev"), 

100 
(35, "0.9.14.1"), 

101 
(37, "0.9.15"), 

4583  102 
(38, "0.9.16dev")] 
1804  103 

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

107 
hFlush stdout 
4921  108 
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

109 

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

110 

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

111 
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

112 
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

113 
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

114 
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

115 
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

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

118 
showB = B.pack .show 