author | unc0rr |
Mon, 26 Nov 2012 00:06:42 +0400 | |
branch | flibqtfrontend |
changeset 8106 | 861d145b270e |
parent 8002 | 8113afd3858f |
child 8189 | 328f429c3ecc |
permissions | -rw-r--r-- |
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 HWProtoInRoomState where |
3 |
||
4 |
import qualified Data.Map as Map |
|
7766 | 5 |
import Data.Sequence((|>)) |
7862
bd76ca40db68
Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents:
7775
diff
changeset
|
6 |
import Data.List as L |
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
|
7 |
import Data.Maybe |
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
|
8 |
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
|
9 |
import Control.Monad |
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
|
10 |
import Control.Monad.Reader |
8002 | 11 |
import Control.DeepSeq |
1804 | 12 |
-------------------------------------- |
13 |
import CoreTypes |
|
14 |
import Actions |
|
15 |
import Utils |
|
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
|
16 |
import HandlerUtils |
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 RoomsAndClients |
6068 | 18 |
import EngineInteraction |
1804 | 19 |
|
4989 | 20 |
handleCmd_inRoom :: CmdHandler |
1804 | 21 |
|
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
|
22 |
handleCmd_inRoom ["CHAT", msg] = do |
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 |
n <- clientNick |
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
|
24 |
s <- roomOthersChans |
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 |
return [AnswerClients s ["CHAT", n, msg]] |
1804 | 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 |
handleCmd_inRoom ["PART"] = return [MoveToLobby "part"] |
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 |
handleCmd_inRoom ["PART", msg] = return [MoveToLobby $ "part: " `B.append` msg] |
3531 | 29 |
|
1811 | 30 |
|
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
|
31 |
handleCmd_inRoom ("CFG" : paramName : paramStrs) |
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 |
| null paramStrs = return [ProtocolError "Empty config entry"] |
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 |
| otherwise = do |
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 |
chans <- roomOthersChans |
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 |
cl <- thisClient |
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 |
if isMaster cl then |
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 |
return [ |
4941 | 38 |
ModifyRoom f, |
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
|
39 |
AnswerClients chans ("CFG" : paramName : paramStrs)] |
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
|
40 |
else |
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 |
return [ProtocolError "Not room master"] |
4941 | 42 |
where |
43 |
f r = if paramName `Map.member` (mapParams r) then |
|
44 |
r{mapParams = Map.insert paramName (head paramStrs) (mapParams r)} |
|
45 |
else |
|
46 |
r{params = Map.insert paramName paramStrs (params r)} |
|
1804 | 47 |
|
4932 | 48 |
handleCmd_inRoom ("ADD_TEAM" : tName : color : grave : fort : voicepack : flag : difStr : hhsInfo) |
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
|
49 |
| length hhsInfo /= 16 = return [ProtocolError "Corrupted hedgehogs info"] |
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 |
| otherwise = do |
4932 | 51 |
(ci, _) <- ask |
52 |
rm <- thisRoom |
|
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
|
53 |
clNick <- clientNick |
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 |
clChan <- thisClientChans |
4932 | 55 |
othChans <- roomOthersChans |
7862
bd76ca40db68
Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents:
7775
diff
changeset
|
56 |
roomChans <- roomClientsChans |
bd76ca40db68
Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents:
7775
diff
changeset
|
57 |
cl <- thisClient |
bd76ca40db68
Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents:
7775
diff
changeset
|
58 |
teamColor <- |
bd76ca40db68
Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents:
7775
diff
changeset
|
59 |
if clientProto cl < 42 then |
bd76ca40db68
Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents:
7775
diff
changeset
|
60 |
return color |
bd76ca40db68
Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents:
7775
diff
changeset
|
61 |
else |
bd76ca40db68
Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents:
7775
diff
changeset
|
62 |
liftM (head . (L.\\) (map B.singleton ['0'..]) . map teamcolor . teams) thisRoom |
7986
53b1da5ee7f4
Maybe this caused server crashes? Add more strictness on team owner record field
unc0rr
parents:
7947
diff
changeset
|
63 |
let newTeam = clNick `seq` TeamInfo ci clNick tName teamColor grave fort voicepack flag dif (newTeamHHNum rm) (hhsList hhsInfo) |
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
|
64 |
return $ |
5931 | 65 |
if not . null . drop (maxTeams rm - 1) $ teams rm then |
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
|
66 |
[Warning "too many teams"] |
4932 | 67 |
else if canAddNumber rm <= 0 then |
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
|
68 |
[Warning "too many hedgehogs"] |
4932 | 69 |
else if isJust $ findTeam rm then |
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
|
70 |
[Warning "There's already a team with same name in the list"] |
5996
2c72fe81dd37
Convert boolean variable + a bunch of fields which make sense only while game is going on into Maybe + structure
unc0rr
parents:
5931
diff
changeset
|
71 |
else if isJust $ gameInfo rm then |
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
|
72 |
[Warning "round in progress"] |
4932 | 73 |
else if isRestrictedTeams rm then |
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 |
[Warning "restricted"] |
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
|
75 |
else |
7986
53b1da5ee7f4
Maybe this caused server crashes? Add more strictness on team owner record field
unc0rr
parents:
7947
diff
changeset
|
76 |
[ModifyRoom (\r -> r{teams = teams r ++ [newTeam]}), |
7921
6b074de32bea
Send ROOM UPD message when team is added/deleted from room, and when game starts or finishes
unc0rr
parents:
7862
diff
changeset
|
77 |
SendUpdateOnThisRoom, |
7862
bd76ca40db68
Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents:
7775
diff
changeset
|
78 |
ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = Just teamColor}), |
4932 | 79 |
AnswerClients clChan ["TEAM_ACCEPTED", tName], |
7986
53b1da5ee7f4
Maybe this caused server crashes? Add more strictness on team owner record field
unc0rr
parents:
7947
diff
changeset
|
80 |
AnswerClients othChans $ teamToNet $ newTeam, |
7862
bd76ca40db68
Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents:
7775
diff
changeset
|
81 |
AnswerClients roomChans ["TEAM_COLOR", tName, teamColor] |
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
|
82 |
] |
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
|
83 |
where |
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 |
canAddNumber r = 48 - (sum . map hhnum $ teams r) |
4932 | 85 |
findTeam = find (\t -> tName == teamname t) . teams |
5030
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4989
diff
changeset
|
86 |
dif = readInt_ difStr |
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
|
87 |
hhsList [] = [] |
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
|
88 |
hhsList [_] = error "Hedgehogs list with odd elements number" |
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
|
89 |
hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs |
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
|
90 |
newTeamHHNum r = min 4 (canAddNumber r) |
7321
57bd4f201401
- Try sending remove message in 'finally' as a last resort
unc0rr
parents:
7266
diff
changeset
|
91 |
maxTeams r |
5931 | 92 |
| roomProto r < 38 = 6 |
93 |
| otherwise = 8 |
|
7321
57bd4f201401
- Try sending remove message in 'finally' as a last resort
unc0rr
parents:
7266
diff
changeset
|
94 |
|
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
|
95 |
|
4932 | 96 |
handleCmd_inRoom ["REMOVE_TEAM", tName] = do |
97 |
(ci, _) <- ask |
|
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
|
98 |
r <- thisRoom |
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
|
99 |
clNick <- clientNick |
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
|
100 |
|
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
|
101 |
let maybeTeam = findTeam r |
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
|
102 |
let team = fromJust maybeTeam |
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
|
103 |
|
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
|
104 |
return $ |
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
|
105 |
if isNothing $ findTeam r then |
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
|
106 |
[Warning "REMOVE_TEAM: no such 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
|
107 |
else if clNick /= teamowner team then |
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
|
108 |
[ProtocolError "Not team owner!"] |
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 |
else |
4932 | 110 |
[RemoveTeam tName, |
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
|
111 |
ModifyClient |
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 |
(\c -> c{ |
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 |
teamsInGame = teamsInGame c - 1, |
4989 | 114 |
clientClan = if teamsInGame c == 1 then Nothing else Just $ anotherTeamClan ci r |
115 |
}) |
|
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
|
116 |
] |
4568 | 117 |
where |
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
|
118 |
anotherTeamClan ci = teamcolor . fromJust . find (\t -> teamownerId t == ci) . teams |
4932 | 119 |
findTeam = find (\t -> tName == teamname t) . teams |
3561 | 120 |
|
3568 | 121 |
|
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
|
122 |
handleCmd_inRoom ["HH_NUM", teamName, numberStr] = do |
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 |
cl <- thisClient |
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 |
others <- roomOthersChans |
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
|
125 |
r <- thisRoom |
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
|
126 |
|
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
|
127 |
let maybeTeam = findTeam r |
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
|
128 |
let team = fromJust maybeTeam |
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
|
129 |
|
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
|
130 |
return $ |
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
|
131 |
if not $ isMaster cl then |
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
|
132 |
[ProtocolError "Not room master"] |
4932 | 133 |
else if hhNumber < 1 || hhNumber > 8 || isNothing maybeTeam || hhNumber > canAddNumber r + hhnum team then |
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
|
134 |
[] |
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
|
135 |
else |
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
|
136 |
[ModifyRoom $ modifyTeam team{hhnum = hhNumber}, |
5030
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4989
diff
changeset
|
137 |
AnswerClients others ["HH_NUM", teamName, showB hhNumber]] |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
138 |
where |
5030
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4989
diff
changeset
|
139 |
hhNumber = readInt_ numberStr |
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
|
140 |
findTeam = find (\t -> teamName == teamname t) . teams |
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
|
141 |
canAddNumber = (-) 48 . sum . map hhnum . teams |
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
|
142 |
|
1804 | 143 |
|
3568 | 144 |
|
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
|
145 |
handleCmd_inRoom ["TEAM_COLOR", teamName, newColor] = do |
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
|
146 |
cl <- thisClient |
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
|
147 |
others <- roomOthersChans |
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
|
148 |
r <- thisRoom |
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
|
149 |
|
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
|
150 |
let maybeTeam = findTeam r |
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
|
151 |
let team = fromJust maybeTeam |
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
|
152 |
|
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
|
153 |
return $ |
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
|
154 |
if not $ isMaster cl then |
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
|
155 |
[ProtocolError "Not room master"] |
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
|
156 |
else if isNothing maybeTeam then |
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
|
157 |
[] |
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
|
158 |
else |
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
|
159 |
[ModifyRoom $ modifyTeam team{teamcolor = newColor}, |
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
|
160 |
AnswerClients others ["TEAM_COLOR", teamName, newColor], |
4986
33fe91b2bcbf
Use Maybe for storing client's clan, allows less error-prone spectator checks
unc0rr
parents:
4975
diff
changeset
|
161 |
ModifyClient2 (teamownerId team) (\c -> c{clientClan = Just newColor})] |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
162 |
where |
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
|
163 |
findTeam = find (\t -> teamName == teamname t) . teams |
3568 | 164 |
|
1804 | 165 |
|
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
|
166 |
handleCmd_inRoom ["TOGGLE_READY"] = do |
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
|
167 |
cl <- thisClient |
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
|
168 |
chans <- roomClientsChans |
7775 | 169 |
if isMaster cl then |
170 |
return [] |
|
171 |
else |
|
172 |
return [ |
|
173 |
ModifyRoom (\r -> r{readyPlayers = readyPlayers r + (if isReady cl then -1 else 1)}), |
|
174 |
ModifyClient (\c -> c{isReady = not $ isReady cl}), |
|
175 |
AnswerClients chans $ if clientProto cl < 38 then |
|
176 |
[if isReady cl then "NOT_READY" else "READY", nick cl] |
|
177 |
else |
|
178 |
["CLIENT_FLAGS", if isReady cl then "-r" else "+r", nick cl] |
|
179 |
] |
|
1804 | 180 |
|
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
|
181 |
handleCmd_inRoom ["START_GAME"] = do |
6012 | 182 |
(ci, rnc) <- ask |
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
|
183 |
cl <- thisClient |
4932 | 184 |
rm <- thisRoom |
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
|
185 |
chans <- roomClientsChans |
7321
57bd4f201401
- Try sending remove message in 'finally' as a last resort
unc0rr
parents:
7266
diff
changeset
|
186 |
|
7765
1e162c1d6dc7
'In game' client flag, both server and frontend support
unc0rr
parents:
7757
diff
changeset
|
187 |
let nicks = map (nick . client rnc) . roomClients rnc $ clientRoom rnc ci |
6012 | 188 |
let allPlayersRegistered = all ((<) 0 . B.length . webPassword . client rnc . teamownerId) $ teams rm |
3577 | 189 |
|
5996
2c72fe81dd37
Convert boolean variable + a bunch of fields which make sense only while game is going on into Maybe + structure
unc0rr
parents:
5931
diff
changeset
|
190 |
if isMaster cl && playersIn rm == readyPlayers rm && not (isJust $ gameInfo rm) then |
4932 | 191 |
if enoughClans rm then |
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
|
192 |
return [ |
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
|
193 |
ModifyRoom |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
194 |
(\r -> r{ |
6756
344d32bb1328
Also consider game finished when the last player reports ROUNDFINISHED despite the correctness parameter.
unc0rr
parents:
6753
diff
changeset
|
195 |
gameInfo = Just $ newGameInfo (teams rm) (length $ teams rm) allPlayersRegistered (mapParams rm) (params rm) |
5996
2c72fe81dd37
Convert boolean variable + a bunch of fields which make sense only while game is going on into Maybe + structure
unc0rr
parents:
5931
diff
changeset
|
196 |
} |
7757
c20e6c80e249
Don't accept ROUNDFINISHED message twice. Fixes game hangs when half of teams quit game.
unc0rr
parents:
7537
diff
changeset
|
197 |
) |
c20e6c80e249
Don't accept ROUNDFINISHED message twice. Fixes game hangs when half of teams quit game.
unc0rr
parents:
7537
diff
changeset
|
198 |
, AnswerClients chans ["RUN_GAME"] |
7921
6b074de32bea
Send ROOM UPD message when team is added/deleted from room, and when game starts or finishes
unc0rr
parents:
7862
diff
changeset
|
199 |
, SendUpdateOnThisRoom |
7765
1e162c1d6dc7
'In game' client flag, both server and frontend support
unc0rr
parents:
7757
diff
changeset
|
200 |
, AnswerClients chans $ "CLIENT_FLAGS" : "+g" : nicks |
7757
c20e6c80e249
Don't accept ROUNDFINISHED message twice. Fixes game hangs when half of teams quit game.
unc0rr
parents:
7537
diff
changeset
|
201 |
, ModifyRoomClients (\c -> c{isInGame = True}) |
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
|
202 |
] |
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
|
203 |
else |
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
|
204 |
return [Warning "Less than two clans!"] |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
205 |
else |
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
|
206 |
return [] |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
207 |
where |
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
|
208 |
enoughClans = not . null . drop 1 . group . map teamcolor . teams |
1804 | 209 |
|
210 |
||
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
|
211 |
handleCmd_inRoom ["EM", msg] = do |
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
|
212 |
cl <- thisClient |
4932 | 213 |
rm <- thisRoom |
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
|
214 |
chans <- roomOthersChans |
4931
da43c36a6e92
Don't accept EM message when the game isn't started
unc0rr
parents:
4917
diff
changeset
|
215 |
|
5996
2c72fe81dd37
Convert boolean variable + a bunch of fields which make sense only while game is going on into Maybe + structure
unc0rr
parents:
5931
diff
changeset
|
216 |
if teamsInGame cl > 0 && (isJust $ gameInfo rm) && isLegal then |
2c72fe81dd37
Convert boolean variable + a bunch of fields which make sense only while game is going on into Maybe + structure
unc0rr
parents:
5931
diff
changeset
|
217 |
return $ AnswerClients chans ["EM", msg] : [ModifyRoom (\r -> r{gameInfo = liftM (\g -> g{roundMsgs = roundMsgs g |> msg}) $ gameInfo r}) | not isKeepAlive] |
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
|
218 |
else |
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
|
219 |
return [] |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
220 |
where |
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
221 |
(isLegal, isKeepAlive) = checkNetCmd msg |
1804 | 222 |
|
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
|
223 |
|
5996
2c72fe81dd37
Convert boolean variable + a bunch of fields which make sense only while game is going on into Maybe + structure
unc0rr
parents:
5931
diff
changeset
|
224 |
handleCmd_inRoom ["ROUNDFINISHED", correctly] = do |
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
|
225 |
cl <- thisClient |
4932 | 226 |
rm <- thisRoom |
7765
1e162c1d6dc7
'In game' client flag, both server and frontend support
unc0rr
parents:
7757
diff
changeset
|
227 |
chans <- roomClientsChans |
1e162c1d6dc7
'In game' client flag, both server and frontend support
unc0rr
parents:
7757
diff
changeset
|
228 |
|
6753
e95b1f62d0de
Don't remove client's teams from teams list on "ROUNDFINISHED 0", just send team removal message to others.
unc0rr
parents:
6738
diff
changeset
|
229 |
let clTeams = map teamname . filter (\t -> teamowner t == nick cl) . teams $ rm |
7765
1e162c1d6dc7
'In game' client flag, both server and frontend support
unc0rr
parents:
7757
diff
changeset
|
230 |
let unsetInGameState = [AnswerClients chans ["CLIENT_FLAGS", "-g", nick cl], ModifyClient (\c -> c{isInGame = False})] |
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
|
231 |
|
7757
c20e6c80e249
Don't accept ROUNDFINISHED message twice. Fixes game hangs when half of teams quit game.
unc0rr
parents:
7537
diff
changeset
|
232 |
if isInGame cl then |
c20e6c80e249
Don't accept ROUNDFINISHED message twice. Fixes game hangs when half of teams quit game.
unc0rr
parents:
7537
diff
changeset
|
233 |
if isJust $ gameInfo rm then |
c20e6c80e249
Don't accept ROUNDFINISHED message twice. Fixes game hangs when half of teams quit game.
unc0rr
parents:
7537
diff
changeset
|
234 |
if (isMaster cl && isCorrect) then |
7765
1e162c1d6dc7
'In game' client flag, both server and frontend support
unc0rr
parents:
7757
diff
changeset
|
235 |
return $ FinishGame : unsetInGameState |
7757
c20e6c80e249
Don't accept ROUNDFINISHED message twice. Fixes game hangs when half of teams quit game.
unc0rr
parents:
7537
diff
changeset
|
236 |
else |
7765
1e162c1d6dc7
'In game' client flag, both server and frontend support
unc0rr
parents:
7757
diff
changeset
|
237 |
return $ unsetInGameState ++ map SendTeamRemovalMessage clTeams |
7757
c20e6c80e249
Don't accept ROUNDFINISHED message twice. Fixes game hangs when half of teams quit game.
unc0rr
parents:
7537
diff
changeset
|
238 |
else |
7765
1e162c1d6dc7
'In game' client flag, both server and frontend support
unc0rr
parents:
7757
diff
changeset
|
239 |
return unsetInGameState |
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
|
240 |
else |
7757
c20e6c80e249
Don't accept ROUNDFINISHED message twice. Fixes game hangs when half of teams quit game.
unc0rr
parents:
7537
diff
changeset
|
241 |
return [] -- don't accept this message twice |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
242 |
where |
5996
2c72fe81dd37
Convert boolean variable + a bunch of fields which make sense only while game is going on into Maybe + structure
unc0rr
parents:
5931
diff
changeset
|
243 |
isCorrect = correctly == "1" |
1811 | 244 |
|
4942
1c85a8e6e11c
Okay, a compatibility layer for clients of 0.9.15 version (not sure about old versions, as I removed all compatibility hacks for older versions previously)
unc0rr
parents:
4941
diff
changeset
|
245 |
-- compatibility with clients with protocol < 38 |
1c85a8e6e11c
Okay, a compatibility layer for clients of 0.9.15 version (not sure about old versions, as I removed all compatibility hacks for older versions previously)
unc0rr
parents:
4941
diff
changeset
|
246 |
handleCmd_inRoom ["ROUNDFINISHED"] = |
1c85a8e6e11c
Okay, a compatibility layer for clients of 0.9.15 version (not sure about old versions, as I removed all compatibility hacks for older versions previously)
unc0rr
parents:
4941
diff
changeset
|
247 |
handleCmd_inRoom ["ROUNDFINISHED", "1"] |
1c85a8e6e11c
Okay, a compatibility layer for clients of 0.9.15 version (not sure about old versions, as I removed all compatibility hacks for older versions previously)
unc0rr
parents:
4941
diff
changeset
|
248 |
|
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
|
249 |
handleCmd_inRoom ["TOGGLE_RESTRICT_JOINS"] = do |
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
|
250 |
cl <- thisClient |
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
|
251 |
return $ |
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
|
252 |
if not $ isMaster cl then |
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
|
253 |
[ProtocolError "Not room master"] |
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
|
254 |
else |
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
|
255 |
[ModifyRoom (\r -> r{isRestrictedJoins = not $ isRestrictedJoins r})] |
4568 | 256 |
|
1831 | 257 |
|
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
|
258 |
handleCmd_inRoom ["TOGGLE_RESTRICT_TEAMS"] = do |
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
|
259 |
cl <- thisClient |
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
|
260 |
return $ |
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
|
261 |
if not $ isMaster cl then |
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
|
262 |
[ProtocolError "Not room master"] |
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
|
263 |
else |
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
|
264 |
[ModifyRoom (\r -> r{isRestrictedTeams = not $ isRestrictedTeams r})] |
1879 | 265 |
|
1831 | 266 |
|
5098 | 267 |
handleCmd_inRoom ["ROOM_NAME", newName] = do |
268 |
cl <- thisClient |
|
269 |
rs <- allRoomInfos |
|
6541
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
6403
diff
changeset
|
270 |
rm <- thisRoom |
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
6403
diff
changeset
|
271 |
chans <- sameProtoChans |
7321
57bd4f201401
- Try sending remove message in 'finally' as a last resort
unc0rr
parents:
7266
diff
changeset
|
272 |
|
5098 | 273 |
return $ |
274 |
if not $ isMaster cl then |
|
275 |
[ProtocolError "Not room master"] |
|
276 |
else |
|
277 |
if isJust $ find (\r -> newName == name r) rs then |
|
278 |
[Warning "Room with such name already exists"] |
|
279 |
else |
|
6541
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
6403
diff
changeset
|
280 |
[ModifyRoom roomUpdate, |
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
6403
diff
changeset
|
281 |
AnswerClients chans ("ROOM" : "UPD" : name rm : roomInfo (nick cl) (roomUpdate rm))] |
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
6403
diff
changeset
|
282 |
where |
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
6403
diff
changeset
|
283 |
roomUpdate r = r{name = newName} |
5098 | 284 |
|
285 |
||
4614 | 286 |
handleCmd_inRoom ["KICK", kickNick] = do |
287 |
(thisClientId, rnc) <- ask |
|
288 |
maybeClientId <- clientByNick kickNick |
|
289 |
master <- liftM isMaster thisClient |
|
290 |
let kickId = fromJust maybeClientId |
|
4932 | 291 |
let sameRoom = clientRoom rnc thisClientId == clientRoom rnc kickId |
4614 | 292 |
return |
293 |
[KickRoomClient kickId | master && isJust maybeClientId && (kickId /= thisClientId) && sameRoom] |
|
1879 | 294 |
|
1831 | 295 |
|
4614 | 296 |
handleCmd_inRoom ["TEAMCHAT", msg] = do |
297 |
cl <- thisClient |
|
298 |
chans <- roomSameClanChans |
|
299 |
return [AnswerClients chans ["EM", engineMsg cl]] |
|
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
300 |
where |
5030
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4989
diff
changeset
|
301 |
engineMsg cl = toEngineMsg $ B.concat ["b", nick cl, "(team): ", msg, "\x20\x20"] |
4568 | 302 |
|
7537
833a0c34fafc
Room bans. They're more simple, than the global ones: if you ban someone, he is banned by ip in this room for the rest of the room lifetime. Not tested.
unc0rr
parents:
7321
diff
changeset
|
303 |
handleCmd_inRoom ["BAN", banNick] = do |
8002 | 304 |
(thisClientId, rnc) <- ask |
7537
833a0c34fafc
Room bans. They're more simple, than the global ones: if you ban someone, he is banned by ip in this room for the rest of the room lifetime. Not tested.
unc0rr
parents:
7321
diff
changeset
|
305 |
maybeClientId <- clientByNick banNick |
8002 | 306 |
master <- liftM isMaster thisClient |
7537
833a0c34fafc
Room bans. They're more simple, than the global ones: if you ban someone, he is banned by ip in this room for the rest of the room lifetime. Not tested.
unc0rr
parents:
7321
diff
changeset
|
307 |
let banId = fromJust maybeClientId |
8002 | 308 |
let sameRoom = clientRoom rnc thisClientId == clientRoom rnc banId |
309 |
if master && isJust maybeClientId && (banId /= thisClientId) && sameRoom then |
|
310 |
return [ |
|
311 |
ModifyRoom (\r -> r{roomBansList = let h = host $ rnc `client` banId in h `deepseq` h : roomBansList r}) |
|
312 |
, KickRoomClient banId |
|
313 |
] |
|
314 |
else |
|
315 |
return [] |
|
7537
833a0c34fafc
Room bans. They're more simple, than the global ones: if you ban someone, he is banned by ip in this room for the rest of the room lifetime. Not tested.
unc0rr
parents:
7321
diff
changeset
|
316 |
|
833a0c34fafc
Room bans. They're more simple, than the global ones: if you ban someone, he is banned by ip in this room for the rest of the room lifetime. Not tested.
unc0rr
parents:
7321
diff
changeset
|
317 |
|
6912
831416764d2d
Allow LIST command while in room to not annoy old frontends (0.9.17 or less) with warnings
unc0rr
parents:
6815
diff
changeset
|
318 |
handleCmd_inRoom ["LIST"] = return [] -- for old clients (<= 0.9.17) |
831416764d2d
Allow LIST command while in room to not annoy old frontends (0.9.17 or less) with warnings
unc0rr
parents:
6815
diff
changeset
|
319 |
|
6721
7dbf8a0c1f5d
- Register HWTeam metatype so HWTeam objects could be passed via queued connections
unc0rr
parents:
6690
diff
changeset
|
320 |
handleCmd_inRoom (s:_) = return [ProtocolError $ "Incorrect command '" `B.append` s `B.append` "' (state: in room)"] |
7dbf8a0c1f5d
- Register HWTeam metatype so HWTeam objects could be passed via queued connections
unc0rr
parents:
6690
diff
changeset
|
321 |
|
7dbf8a0c1f5d
- Register HWTeam metatype so HWTeam objects could be passed via queued connections
unc0rr
parents:
6690
diff
changeset
|
322 |
handleCmd_inRoom [] = return [ProtocolError "Empty command (state: in room)"] |