1.2.11
by Dmitry E. Oboukhov
Import upstream version 0.9.16 |
1 |
{-# LANGUAGE OverloadedStrings #-}
|
1.2.9
by Dmitry E. Oboukhov
Import upstream version 0.9.14.1 |
2 |
module HWProtoLobbyState where |
3 |
||
1.2.10
by Dmitry E. Oboukhov
Import upstream version 0.9.15 |
4 |
import Data.Maybe |
1.2.9
by Dmitry E. Oboukhov
Import upstream version 0.9.14.1 |
5 |
import Data.List |
1.2.11
by Dmitry E. Oboukhov
Import upstream version 0.9.16 |
6 |
import Control.Monad.Reader |
1.2.16
by Gianfranco Costamagna
Import upstream version 0.9.20 |
7 |
import qualified Data.ByteString.Char8 as B |
1.2.9
by Dmitry E. Oboukhov
Import upstream version 0.9.14.1 |
8 |
--------------------------------------
|
9 |
import CoreTypes |
|
10 |
import Actions |
|
11 |
import Utils |
|
1.2.11
by Dmitry E. Oboukhov
Import upstream version 0.9.16 |
12 |
import HandlerUtils |
13 |
import RoomsAndClients |
|
1.2.12
by Dmitry E. Oboukhov
Import upstream version 0.9.17 |
14 |
import EngineInteraction |
1.2.11
by Dmitry E. Oboukhov
Import upstream version 0.9.16 |
15 |
|
16 |
||
1.2.9
by Dmitry E. Oboukhov
Import upstream version 0.9.14.1 |
17 |
handleCmd_lobby :: CmdHandler |
18 |
||
1.2.11
by Dmitry E. Oboukhov
Import upstream version 0.9.16 |
19 |
|
20 |
handleCmd_lobby ["LIST"] = do |
|
21 |
(ci, irnc) <- ask |
|
22 |
let cl = irnc `client` ci |
|
23 |
rooms <- allRoomInfos |
|
1.2.16
by Gianfranco Costamagna
Import upstream version 0.9.20 |
24 |
let roomsInfoList = concatMap (\r -> roomInfo (clientProto cl) (maybeNick . liftM (client irnc) $ masterID r) r) . filter (\r -> (roomProto r == clientProto cl)) |
1.2.11
by Dmitry E. Oboukhov
Import upstream version 0.9.16 |
25 |
return [AnswerClients [sendChan cl] ("ROOMS" : roomsInfoList rooms)] |
26 |
||
27 |
handleCmd_lobby ["CHAT", msg] = do |
|
28 |
n <- clientNick |
|
29 |
s <- roomOthersChans |
|
30 |
return [AnswerClients s ["CHAT", n, msg]] |
|
31 |
||
32 |
handleCmd_lobby ["CREATE_ROOM", rName, roomPassword] |
|
1.2.14
by Gianfranco Costamagna
Import upstream version 0.9.19.2 |
33 |
| illegalName rName = return [Warning $ loc "Illegal room name"] |
1.2.11
by Dmitry E. Oboukhov
Import upstream version 0.9.16 |
34 |
| otherwise = do |
35 |
rs <- allRoomInfos |
|
36 |
cl <- thisClient |
|
37 |
return $ if isJust $ find (\r -> rName == name r) rs then |
|
38 |
[Warning "Room exists"] |
|
39 |
else
|
|
40 |
[
|
|
1.2.13
by Gianfranco Costamagna
Import upstream version 0.9.18 |
41 |
AddRoom rName roomPassword |
42 |
, AnswerClients [sendChan cl] ["CLIENT_FLAGS", "+hr", nick cl] |
|
1.2.16
by Gianfranco Costamagna
Import upstream version 0.9.20 |
43 |
, ModifyClient (\c -> c{isMaster = True, isReady = True, isJoinedMidGame = False}) |
1.2.13
by Gianfranco Costamagna
Import upstream version 0.9.18 |
44 |
, ModifyRoom (\r -> r{readyPlayers = 1}) |
1.2.11
by Dmitry E. Oboukhov
Import upstream version 0.9.16 |
45 |
]
|
46 |
||
47 |
||
48 |
handleCmd_lobby ["CREATE_ROOM", rName] = |
|
49 |
handleCmd_lobby ["CREATE_ROOM", rName, ""] |
|
50 |
||
51 |
||
52 |
handleCmd_lobby ["JOIN_ROOM", roomName, roomPassword] = do |
|
53 |
(_, irnc) <- ask |
|
54 |
let ris = allRooms irnc |
|
55 |
cl <- thisClient |
|
56 |
let maybeRI = find (\ri -> roomName == name (irnc `room` ri)) ris |
|
57 |
let jRI = fromJust maybeRI |
|
58 |
let jRoom = irnc `room` jRI |
|
59 |
let sameProto = clientProto cl == roomProto jRoom |
|
60 |
let jRoomClients = map (client irnc) $ roomClients irnc jRI |
|
61 |
let nicks = map nick jRoomClients |
|
1.2.16
by Gianfranco Costamagna
Import upstream version 0.9.20 |
62 |
let owner = find isMaster jRoomClients |
1.2.11
by Dmitry E. Oboukhov
Import upstream version 0.9.16 |
63 |
let chans = map sendChan (cl : jRoomClients) |
1.2.13
by Gianfranco Costamagna
Import upstream version 0.9.18 |
64 |
let isBanned = host cl `elem` roomBansList jRoom |
1.2.11
by Dmitry E. Oboukhov
Import upstream version 0.9.16 |
65 |
return $ |
1.2.16
by Gianfranco Costamagna
Import upstream version 0.9.20 |
66 |
if isNothing maybeRI then |
1.2.14
by Gianfranco Costamagna
Import upstream version 0.9.19.2 |
67 |
[Warning $ loc "No such room"] |
1.2.16
by Gianfranco Costamagna
Import upstream version 0.9.20 |
68 |
else if not sameProto then |
69 |
[Warning $ loc "Room version incompatible to your hedgewars version"] |
|
1.2.11
by Dmitry E. Oboukhov
Import upstream version 0.9.16 |
70 |
else if isRestrictedJoins jRoom then |
1.2.14
by Gianfranco Costamagna
Import upstream version 0.9.19.2 |
71 |
[Warning $ loc "Joining restricted"] |
1.2.16
by Gianfranco Costamagna
Import upstream version 0.9.20 |
72 |
else if isRegisteredOnly jRoom && (B.null . webPassword $ cl) && not (isAdministrator cl) then |
1.2.14
by Gianfranco Costamagna
Import upstream version 0.9.19.2 |
73 |
[Warning $ loc "Registered users only"] |
1.2.13
by Gianfranco Costamagna
Import upstream version 0.9.18 |
74 |
else if isBanned then |
1.2.14
by Gianfranco Costamagna
Import upstream version 0.9.19.2 |
75 |
[Warning $ loc "You are banned in this room"] |
1.2.11
by Dmitry E. Oboukhov
Import upstream version 0.9.16 |
76 |
else if roomPassword /= password jRoom then |
1.2.13
by Gianfranco Costamagna
Import upstream version 0.9.18 |
77 |
[NoticeMessage WrongPassword] |
1.2.11
by Dmitry E. Oboukhov
Import upstream version 0.9.16 |
78 |
else
|
1.2.16
by Gianfranco Costamagna
Import upstream version 0.9.20 |
79 |
(
|
1.2.13
by Gianfranco Costamagna
Import upstream version 0.9.18 |
80 |
MoveToRoom jRI |
1.2.16
by Gianfranco Costamagna
Import upstream version 0.9.20 |
81 |
: ModifyClient (\c -> c{isJoinedMidGame = isJust $ gameInfo jRoom}) |
82 |
: AnswerClients chans ["CLIENT_FLAGS", "-r", nick cl] |
|
83 |
: [(AnswerClients [sendChan cl] $ "JOINED" : nicks) | not $ null nicks] |
|
84 |
)
|
|
85 |
++ [AnswerClients [sendChan cl] ["CLIENT_FLAGS", "+h", nick $ fromJust owner] | isJust owner] |
|
86 |
++ [sendStateFlags cl jRoomClients | not $ null jRoomClients] |
|
87 |
++ answerFullConfig cl jRoom |
|
1.2.11
by Dmitry E. Oboukhov
Import upstream version 0.9.16 |
88 |
++ answerTeams cl jRoom |
1.2.14
by Gianfranco Costamagna
Import upstream version 0.9.19.2 |
89 |
++ watchRound cl jRoom chans |
1.2.16
by Gianfranco Costamagna
Import upstream version 0.9.20 |
90 |
++ [AnswerClients [sendChan cl] ["CHAT", "[greeting]", greeting jRoom] | greeting jRoom /= ""] |
1.2.11
by Dmitry E. Oboukhov
Import upstream version 0.9.16 |
91 |
|
92 |
where
|
|
1.2.14
by Gianfranco Costamagna
Import upstream version 0.9.19.2 |
93 |
sendStateFlags cl clients = AnswerClients [sendChan cl] . concat . intersperse [""] . filter (not . null) . concat $ |
94 |
[f "+r" ready, f "-r" unready, f "+g" ingame, f "-g" inroomlobby] |
|
95 |
where
|
|
96 |
(ready, unready) = partition isReady clients |
|
97 |
(ingame, inroomlobby) = partition isInGame clients |
|
98 |
f fl lst = ["CLIENT_FLAGS" : fl : map nick lst | not $ null lst] |
|
1.2.11
by Dmitry E. Oboukhov
Import upstream version 0.9.16 |
99 |
|
1.2.16
by Gianfranco Costamagna
Import upstream version 0.9.20 |
100 |
-- get config from gameInfo if possible, otherwise from room
|
101 |
answerFullConfig cl jRoom = let f r g = (if isJust $ gameInfo jRoom then g . fromJust . gameInfo else r) jRoom |
|
102 |
in answerFullConfigParams cl (f mapParams giMapParams) (f params giParams) |
|
1.2.11
by Dmitry E. Oboukhov
Import upstream version 0.9.16 |
103 |
|
1.2.12
by Dmitry E. Oboukhov
Import upstream version 0.9.17 |
104 |
answerTeams cl jRoom = let f = if isJust $ gameInfo jRoom then teamsAtStart . fromJust . gameInfo else teams in answerAllTeams cl $ f jRoom |
1.2.11
by Dmitry E. Oboukhov
Import upstream version 0.9.16 |
105 |
|
1.2.14
by Gianfranco Costamagna
Import upstream version 0.9.19.2 |
106 |
watchRound cl jRoom chans = if isNothing $ gameInfo jRoom then |
1.2.9
by Dmitry E. Oboukhov
Import upstream version 0.9.14.1 |
107 |
[]
|
108 |
else
|
|
1.2.16
by Gianfranco Costamagna
Import upstream version 0.9.20 |
109 |
AnswerClients [sendChan cl] ["RUN_GAME"] |
110 |
: AnswerClients chans ["CLIENT_FLAGS", "+g", nick cl] |
|
111 |
: ModifyClient (\c -> c{isInGame = True}) |
|
112 |
: [AnswerClients [sendChan cl] $ "EM" : toEngineMsg "e$spectate 1" : (reverse . roundMsgs . fromJust . gameInfo $ jRoom)] |
|
1.2.11
by Dmitry E. Oboukhov
Import upstream version 0.9.16 |
113 |
|
114 |
||
115 |
handleCmd_lobby ["JOIN_ROOM", roomName] = |
|
116 |
handleCmd_lobby ["JOIN_ROOM", roomName, ""] |
|
117 |
||
118 |
||
119 |
handleCmd_lobby ["FOLLOW", asknick] = do |
|
120 |
(_, rnc) <- ask |
|
1.2.14
by Gianfranco Costamagna
Import upstream version 0.9.19.2 |
121 |
clChan <- liftM sendChan thisClient |
1.2.11
by Dmitry E. Oboukhov
Import upstream version 0.9.16 |
122 |
ci <- clientByNick asknick |
123 |
let ri = clientRoom rnc $ fromJust ci |
|
1.2.14
by Gianfranco Costamagna
Import upstream version 0.9.19.2 |
124 |
let roomName = name $ room rnc ri |
1.2.11
by Dmitry E. Oboukhov
Import upstream version 0.9.16 |
125 |
if isNothing ci || ri == lobbyId then |
126 |
return [] |
|
127 |
else
|
|
1.2.14
by Gianfranco Costamagna
Import upstream version 0.9.19.2 |
128 |
liftM ((:) (AnswerClients [clChan] ["JOINING", roomName])) $ handleCmd_lobby ["JOIN_ROOM", roomName] |
129 |
||
130 |
||
131 |
handleCmd_lobby ("RND":rs) = do |
|
132 |
c <- liftM sendChan thisClient |
|
133 |
return [Random [c] rs] |
|
1.2.9
by Dmitry E. Oboukhov
Import upstream version 0.9.14.1 |
134 |
|
135 |
---------------------------
|
|
136 |
-- Administrator's stuff --
|
|
137 |
||
1.2.11
by Dmitry E. Oboukhov
Import upstream version 0.9.16 |
138 |
handleCmd_lobby ["KICK", kickNick] = do |
139 |
(ci, _) <- ask |
|
140 |
cl <- thisClient |
|
141 |
kickId <- clientByNick kickNick |
|
142 |
return [KickClient $ fromJust kickId | isAdministrator cl && isJust kickId && fromJust kickId /= ci] |
|
143 |
||
144 |
||
1.2.14
by Gianfranco Costamagna
Import upstream version 0.9.19.2 |
145 |
handleCmd_lobby ["BAN", banNick, reason, duration] = do |
1.2.11
by Dmitry E. Oboukhov
Import upstream version 0.9.16 |
146 |
(ci, _) <- ask |
147 |
cl <- thisClient |
|
148 |
banId <- clientByNick banNick |
|
1.2.14
by Gianfranco Costamagna
Import upstream version 0.9.19.2 |
149 |
return [BanClient (readInt_ duration) reason (fromJust banId) | isAdministrator cl && isJust banId && fromJust banId /= ci] |
1.2.13
by Gianfranco Costamagna
Import upstream version 0.9.18 |
150 |
|
1.2.11
by Dmitry E. Oboukhov
Import upstream version 0.9.16 |
151 |
handleCmd_lobby ["BANIP", ip, reason, duration] = do |
152 |
cl <- thisClient |
|
153 |
return [BanIP ip (readInt_ duration) reason | isAdministrator cl] |
|
1.2.13
by Gianfranco Costamagna
Import upstream version 0.9.18 |
154 |
|
1.2.14
by Gianfranco Costamagna
Import upstream version 0.9.19.2 |
155 |
handleCmd_lobby ["BANNICK", n, reason, duration] = do |
156 |
cl <- thisClient |
|
157 |
return [BanNick n (readInt_ duration) reason | isAdministrator cl] |
|
158 |
||
1.2.11
by Dmitry E. Oboukhov
Import upstream version 0.9.16 |
159 |
handleCmd_lobby ["BANLIST"] = do |
160 |
cl <- thisClient |
|
161 |
return [BanList | isAdministrator cl] |
|
162 |
||
163 |
||
1.2.13
by Gianfranco Costamagna
Import upstream version 0.9.18 |
164 |
handleCmd_lobby ["UNBAN", entry] = do |
165 |
cl <- thisClient |
|
166 |
return [Unban entry | isAdministrator cl] |
|
167 |
||
168 |
||
1.2.11
by Dmitry E. Oboukhov
Import upstream version 0.9.16 |
169 |
handleCmd_lobby ["SET_SERVER_VAR", "MOTD_NEW", newMessage] = do |
170 |
cl <- thisClient |
|
171 |
return [ModifyServerInfo (\si -> si{serverMessage = newMessage}) | isAdministrator cl] |
|
172 |
||
173 |
handleCmd_lobby ["SET_SERVER_VAR", "MOTD_OLD", newMessage] = do |
|
174 |
cl <- thisClient |
|
175 |
return [ModifyServerInfo (\si -> si{serverMessageForOldVersions = newMessage}) | isAdministrator cl] |
|
176 |
||
177 |
handleCmd_lobby ["SET_SERVER_VAR", "LATEST_PROTO", protoNum] = do |
|
178 |
cl <- thisClient |
|
179 |
return [ModifyServerInfo (\si -> si{latestReleaseVersion = readNum}) | isAdministrator cl && readNum > 0] |
|
180 |
where
|
|
181 |
readNum = readInt_ protoNum |
|
1.2.13
by Gianfranco Costamagna
Import upstream version 0.9.18 |
182 |
|
1.2.11
by Dmitry E. Oboukhov
Import upstream version 0.9.16 |
183 |
handleCmd_lobby ["GET_SERVER_VAR"] = do |
184 |
cl <- thisClient |
|
185 |
return [SendServerVars | isAdministrator cl] |
|
186 |
||
187 |
handleCmd_lobby ["CLEAR_ACCOUNTS_CACHE"] = do |
|
188 |
cl <- thisClient |
|
189 |
return [ClearAccountsCache | isAdministrator cl] |
|
190 |
||
191 |
handleCmd_lobby ["RESTART_SERVER"] = do |
|
192 |
cl <- thisClient |
|
1.2.13
by Gianfranco Costamagna
Import upstream version 0.9.18 |
193 |
return [RestartServer | isAdministrator cl] |
1.2.11
by Dmitry E. Oboukhov
Import upstream version 0.9.16 |
194 |
|
1.2.14
by Gianfranco Costamagna
Import upstream version 0.9.19.2 |
195 |
handleCmd_lobby ["STATS"] = do |
196 |
cl <- thisClient |
|
197 |
return [Stats | isAdministrator cl] |
|
1.2.11
by Dmitry E. Oboukhov
Import upstream version 0.9.16 |
198 |
|
199 |
handleCmd_lobby _ = return [ProtocolError "Incorrect command (state: in lobby)"] |