author  Wuzzy <almikes@aol.com> 
Wed, 13 Apr 2016 02:44:37 +0200  
changeset 11726  4addfad422ab 
parent 11467  f2c36df8c7b1 
child 12114  cdadc1d487f1 
permissions  rwrr 
10460
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10351
diff
changeset

1 
{ 
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10351
diff
changeset

2 
* Hedgewars, a free turn based strategy game 
11046  3 
* Copyright (c) 20042015 Andrey Korotaev <unC0Rr@gmail.com> 
10460
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10351
diff
changeset

4 
* 
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10351
diff
changeset

5 
* This program is free software; you can redistribute it and/or modify 
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10351
diff
changeset

6 
* it under the terms of the GNU General Public License as published by 
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10351
diff
changeset

7 
* the Free Software Foundation; version 2 of the License 
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10351
diff
changeset

8 
* 
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10351
diff
changeset

9 
* This program is distributed in the hope that it will be useful, 
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10351
diff
changeset

10 
* but WITHOUT ANY WARRANTY; without even the implied warranty of 
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10351
diff
changeset

11 
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10351
diff
changeset

12 
* GNU General Public License for more details. 
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10351
diff
changeset

13 
* 
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10351
diff
changeset

14 
* You should have received a copy of the GNU General Public License 
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10351
diff
changeset

15 
* along with this program; if not, write to the Free Software 
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10351
diff
changeset

16 
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 021101301 USA. 
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10351
diff
changeset

17 
\} 
8dcea9087d75
Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10351
diff
changeset

18 

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

19 
{# LANGUAGE OverloadedStrings #} 
1804  20 
module HWProtoLobbyState where 
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 
import Data.Maybe 
1804  23 
import Data.List 
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

24 
import Control.Monad.Reader 
9303  25 
import qualified Data.ByteString.Char8 as B 
1804  26 
 
27 
import CoreTypes 

28 
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

29 
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

30 
import RoomsAndClients 
6068  31 
import EngineInteraction 
1804  32 

4932  33 

4989  34 
handleCmd_lobby :: CmdHandler 
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 

11464  37 
handleCmd_lobby ["LIST"] = do 
38 
(ci, irnc) < ask 

39 
let cl = irnc `client` ci 

40 
rooms < allRoomInfos 

41 
let roomsInfoList = concatMap (\r > roomInfo (clientProto cl) (maybeNick . liftM (client irnc) $ masterID r) r) . filter (\r > (roomProto r == clientProto cl)) 

42 
return $ if hasAskedList cl then [] else 

43 
[ ModifyClient (\c > c{hasAskedList = True}) 

44 
, AnswerClients [sendChan cl] ("ROOMS" : roomsInfoList rooms)] 

3501  45 

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

46 
handleCmd_lobby ["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

47 
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

48 
s < roomOthersChans 
10092  49 
return [AnswerClients s ["CHAT", n, msg], RegisterEvent LobbyChatMessage] 
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 

4932  51 
handleCmd_lobby ["CREATE_ROOM", rName, roomPassword] 
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset

52 
 illegalName rName = return [Warning $ loc "Illegal room name"] 
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 
 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

54 
rs < allRoomInfos 
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 
cl < thisClient 
4932  56 
return $ if isJust $ find (\r > rName == name r) rs 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

57 
[Warning "Room exists"] 
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 
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

59 
[ 
7775  60 
AddRoom rName roomPassword 
61 
, AnswerClients [sendChan cl] ["CLIENT_FLAGS", "+hr", nick cl] 

9109
878f06e9c484
 Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined midgame. Semitested.
unc0rr
parents:
9035
diff
changeset

62 
, ModifyClient (\c > c{isMaster = True, isReady = True, isJoinedMidGame = False}) 
7775  63 
, ModifyRoom (\r > r{readyPlayers = 1}) 
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 
] 
1804  65 

3536  66 

4932  67 
handleCmd_lobby ["CREATE_ROOM", rName] = 
68 
handleCmd_lobby ["CREATE_ROOM", rName, ""] 

3536  69 

1862  70 

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

71 
handleCmd_lobby ["JOIN_ROOM", roomName, roomPassword] = do 
4932  72 
(_, irnc) < ask 
10342
16122539d2ea
Fix build, and also make protocol a bit more consistent and flexible (only in docs though, to be implemented)
unc0rr
parents:
10338
diff
changeset

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 
let ris = allRooms irnc 
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 
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

76 
let maybeRI = find (\ri > roomName == name (irnc `room` ri)) ris 
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

77 
let jRI = fromJust maybeRI 
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

78 
let jRoom = irnc `room` jRI 
5931  79 
let sameProto = clientProto cl == roomProto jRoom 
4597
31e042ab870c
Finally a solution for excess lazyness when working with unsafeThaw'ed arrays
unc0rr
parents:
4595
diff
changeset

80 
let jRoomClients = map (client irnc) $ roomClients irnc jRI 
31e042ab870c
Finally a solution for excess lazyness when working with unsafeThaw'ed arrays
unc0rr
parents:
4595
diff
changeset

81 
let nicks = map nick jRoomClients 
9753
9579596cf471
 Special rooms which stay even when last player quits. Not useful for now, and can't be removed at all.
unc0rr
parents:
9729
diff
changeset

82 
let owner = find isMaster jRoomClients 
4597
31e042ab870c
Finally a solution for excess lazyness when working with unsafeThaw'ed arrays
unc0rr
parents:
4595
diff
changeset

83 
let chans = map sendChan (cl : jRoomClients) 
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

84 
let isBanned = host cl `elem` roomBansList jRoom 
10342
16122539d2ea
Fix build, and also make protocol a bit more consistent and flexible (only in docs though, to be implemented)
unc0rr
parents:
10338
diff
changeset

85 
let clTeams = 
10351
0eff41e9f63f
Restore teams in teams list on rejoin, should fix issues with second rejoin.
unc0rr
parents:
10349
diff
changeset

86 
if (clientProto cl >= 48) && (isJust $ gameInfo jRoom) then 
11056
62cc7f67105f
Restore player clan on rejoin (issue 934, not tested)
unc0rr
parents:
11055
diff
changeset

87 
filter (\t > teamowner t == nick cl) . teamsAtStart . fromJust $ gameInfo jRoom 
10342
16122539d2ea
Fix build, and also make protocol a bit more consistent and flexible (only in docs though, to be implemented)
unc0rr
parents:
10338
diff
changeset

88 
else 
16122539d2ea
Fix build, and also make protocol a bit more consistent and flexible (only in docs though, to be implemented)
unc0rr
parents:
10338
diff
changeset

89 
[] 
11056
62cc7f67105f
Restore player clan on rejoin (issue 934, not tested)
unc0rr
parents:
11055
diff
changeset

90 
let clTeamsNames = map teamname clTeams 
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

91 
return $ 
9729
6a3640c4f4b7
Show "incompatible version" message instead of "no such room" on try to join room with another protocol version
unc0rr
parents:
9702
diff
changeset

92 
if isNothing maybeRI then 
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset

93 
[Warning $ loc "No such room"] 
10337
05a5762ab12c
Allow server admins to join room of another protocol version
unc0rr
parents:
10212
diff
changeset

94 
else if (not sameProto) && (not $ isAdministrator cl) then 
9729
6a3640c4f4b7
Show "incompatible version" message instead of "no such room" on try to join room with another protocol version
unc0rr
parents:
9702
diff
changeset

95 
[Warning $ loc "Room version incompatible to your hedgewars version"] 
11467
f2c36df8c7b1
Allow server admins to join passworded/restricted rooms when it is really needed
unc0rr
parents:
11464
diff
changeset

96 
else if isRestrictedJoins jRoom && not (hasSuperPower cl) then 
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset

97 
[Warning $ loc "Joining restricted"] 
9753
9579596cf471
 Special rooms which stay even when last player quits. Not useful for now, and can't be removed at all.
unc0rr
parents:
9729
diff
changeset

98 
else if isRegisteredOnly jRoom && (B.null . webPassword $ cl) && not (isAdministrator cl) then 
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset

99 
[Warning $ loc "Registered users only"] 
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

100 
else if isBanned then 
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8369
diff
changeset

101 
[Warning $ loc "You are banned in this room"] 
11467
f2c36df8c7b1
Allow server admins to join passworded/restricted rooms when it is really needed
unc0rr
parents:
11464
diff
changeset

102 
else if roomPassword /= password jRoom && not (hasSuperPower cl) then 
6912
831416764d2d
Allow LIST command while in room to not annoy old frontends (0.9.17 or less) with warnings
unc0rr
parents:
6541
diff
changeset

103 
[NoticeMessage WrongPassword] 
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

104 
else 
9753
9579596cf471
 Special rooms which stay even when last player quits. Not useful for now, and can't be removed at all.
unc0rr
parents:
9729
diff
changeset

105 
( 
7682  106 
MoveToRoom jRI 
11056
62cc7f67105f
Restore player clan on rejoin (issue 934, not tested)
unc0rr
parents:
11055
diff
changeset

107 
: ModifyClient (\c > c{isJoinedMidGame = isJust $ gameInfo jRoom 
62cc7f67105f
Restore player clan on rejoin (issue 934, not tested)
unc0rr
parents:
11055
diff
changeset

108 
, teamsInGame = fromIntegral $ length clTeams 
62cc7f67105f
Restore player clan on rejoin (issue 934, not tested)
unc0rr
parents:
11055
diff
changeset

109 
, clientClan = teamcolor `fmap` listToMaybe clTeams}) 
9753
9579596cf471
 Special rooms which stay even when last player quits. Not useful for now, and can't be removed at all.
unc0rr
parents:
9729
diff
changeset

110 
: AnswerClients chans ["CLIENT_FLAGS", "r", nick cl] 
9787  111 
: [(AnswerClients [sendChan cl] $ "JOINED" : nicks)  not $ null nicks] 
9753
9579596cf471
 Special rooms which stay even when last player quits. Not useful for now, and can't be removed at all.
unc0rr
parents:
9729
diff
changeset

112 
) 
11056
62cc7f67105f
Restore player clan on rejoin (issue 934, not tested)
unc0rr
parents:
11055
diff
changeset

113 
++ [ModifyRoom (\r > let (t', g') = moveTeams clTeamsNames . fromJust $ gameInfo r in r{gameInfo = Just g', teams = t'})  not $ null clTeams] 
9787  114 
++ [AnswerClients [sendChan cl] ["CLIENT_FLAGS", "+h", nick $ fromJust owner]  isJust owner] 
115 
++ [sendStateFlags cl jRoomClients  not $ null jRoomClients] 

9109
878f06e9c484
 Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined midgame. Semitested.
unc0rr
parents:
9035
diff
changeset

116 
++ answerFullConfig cl jRoom 
8897
d6c310c65c91
 Revert server workaround over desync from r98e2dbdda8c0
unc0rr
parents:
8519
diff
changeset

117 
++ answerTeams cl jRoom 
d6c310c65c91
 Revert server workaround over desync from r98e2dbdda8c0
unc0rr
parents:
8519
diff
changeset

118 
++ watchRound cl jRoom chans 
9787  119 
++ [AnswerClients [sendChan cl] ["CHAT", "[greeting]", greeting jRoom]  greeting jRoom /= ""] 
11056
62cc7f67105f
Restore player clan on rejoin (issue 934, not tested)
unc0rr
parents:
11055
diff
changeset

120 
++ map (\t > AnswerClients chans ["EM", toEngineMsg $ 'G' `B.cons` t]) clTeamsNames 
11055
c1c3f86af19e
Fix inverse paused state for spectators joining paused game (not tested)
unc0rr
parents:
11046
diff
changeset

121 
++ [AnswerClients [sendChan cl] ["EM", toEngineMsg "I"]  isPaused `fmap` gameInfo jRoom == Just True] 
1804  122 

4587  123 
where 
10351
0eff41e9f63f
Restore teams in teams list on rejoin, should fix issues with second rejoin.
unc0rr
parents:
10349
diff
changeset

124 
moveTeams :: [B.ByteString] > GameInfo > ([TeamInfo], GameInfo) 
0eff41e9f63f
Restore teams in teams list on rejoin, should fix issues with second rejoin.
unc0rr
parents:
10349
diff
changeset

125 
moveTeams cts g = (deleteFirstsBy2 (\a b > teamname a == b) (teamsAtStart g) (leftTeams g \\ cts) 
10814
810ac1d21fd0
This should help with second rejoin bug. (reverting previous workaround over frontend bug and making a new one)
unc0rr
parents:
10734
diff
changeset

126 
, g{leftTeams = leftTeams g \\ cts, rejoinedTeams = rejoinedTeams g ++ cts, teamsInGameNumber = teamsInGameNumber g + length cts}) 
8235  127 
sendStateFlags cl clients = AnswerClients [sendChan cl] . concat . intersperse [""] . filter (not . null) . concat $ 
128 
[f "+r" ready, f "r" unready, f "+g" ingame, f "g" inroomlobby] 

129 
where 

130 
(ready, unready) = partition isReady clients 

131 
(ingame, inroomlobby) = partition isInGame clients 

132 
f fl lst = ["CLIENT_FLAGS" : fl : map nick lst  not $ null lst] 

3536  133 

9109
878f06e9c484
 Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined midgame. Semitested.
unc0rr
parents:
9035
diff
changeset

134 
 get config from gameInfo if possible, otherwise from room 
878f06e9c484
 Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined midgame. Semitested.
unc0rr
parents:
9035
diff
changeset

135 
answerFullConfig cl jRoom = let f r g = (if isJust $ gameInfo jRoom then g . fromJust . gameInfo else r) jRoom 
878f06e9c484
 Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined midgame. Semitested.
unc0rr
parents:
9035
diff
changeset

136 
in answerFullConfigParams cl (f mapParams giMapParams) (f params giParams) 
4587  137 

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

138 
answerTeams cl jRoom = let f = if isJust $ gameInfo jRoom then teamsAtStart . fromJust . gameInfo else teams in answerAllTeams cl $ f jRoom 
4591  139 

8237  140 
watchRound cl jRoom chans = if isNothing $ gameInfo jRoom then 
2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2408
diff
changeset

141 
[] 
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2408
diff
changeset

142 
else 
9304
3f4c3fc146c2
Fix spectator desync in rare conditions (there was team which left during its turn, and last command with timestamp from it was '+')
unc0rr
parents:
9303
diff
changeset

143 
AnswerClients [sendChan cl] ["RUN_GAME"] 
3f4c3fc146c2
Fix spectator desync in rare conditions (there was team which left during its turn, and last command with timestamp from it was '+')
unc0rr
parents:
9303
diff
changeset

144 
: AnswerClients chans ["CLIENT_FLAGS", "+g", nick cl] 
3f4c3fc146c2
Fix spectator desync in rare conditions (there was team which left during its turn, and last command with timestamp from it was '+')
unc0rr
parents:
9303
diff
changeset

145 
: ModifyClient (\c > c{isInGame = True}) 
9381  146 
: [AnswerClients [sendChan cl] $ "EM" : toEngineMsg "e$spectate 1" : (reverse . roundMsgs . fromJust . gameInfo $ jRoom)] 
1813  147 

3536  148 

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

149 
handleCmd_lobby ["JOIN_ROOM", roomName] = 
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 
handleCmd_lobby ["JOIN_ROOM", roomName, ""] 
4568  151 

1804  152 

4616  153 
handleCmd_lobby ["FOLLOW", asknick] = do 
154 
(_, rnc) < ask 

8486
9a65baafd7d7
Send JOINING message in response to FOLLOW. Actual join may still fail due to room restrictions. Not tested.
unc0rr
parents:
8403
diff
changeset

155 
clChan < liftM sendChan thisClient 
4616  156 
ci < clientByNick asknick 
157 
let ri = clientRoom rnc $ fromJust ci 

8486
9a65baafd7d7
Send JOINING message in response to FOLLOW. Actual join may still fail due to room restrictions. Not tested.
unc0rr
parents:
8403
diff
changeset

158 
let roomName = name $ room rnc ri 
5931  159 
if isNothing ci  ri == lobbyId then 
4616  160 
return [] 
161 
else 

8486
9a65baafd7d7
Send JOINING message in response to FOLLOW. Actual join may still fail due to room restrictions. Not tested.
unc0rr
parents:
8403
diff
changeset

162 
liftM ((:) (AnswerClients [clChan] ["JOINING", roomName])) $ handleCmd_lobby ["JOIN_ROOM", roomName] 
1862  163 

9035
e84d42a4311c
'/rnd' command. Pass it a (possibly empty) list of items.
unc0rr
parents:
8897
diff
changeset

164 

e84d42a4311c
'/rnd' command. Pass it a (possibly empty) list of items.
unc0rr
parents:
8897
diff
changeset

165 
handleCmd_lobby ("RND":rs) = do 
e84d42a4311c
'/rnd' command. Pass it a (possibly empty) list of items.
unc0rr
parents:
8897
diff
changeset

166 
c < liftM sendChan thisClient 
e84d42a4311c
'/rnd' command. Pass it a (possibly empty) list of items.
unc0rr
parents:
8897
diff
changeset

167 
return [Random [c] rs] 
e84d42a4311c
'/rnd' command. Pass it a (possibly empty) list of items.
unc0rr
parents:
8897
diff
changeset

168 

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

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

170 
 Administrator's stuff  
1862  171 

11032  172 
handleCmd_lobby ["KICK", kickNick] = serverAdminOnly $ do 
4618  173 
(ci, _) < ask 
174 
kickId < clientByNick kickNick 

11032  175 
return [KickClient $ fromJust kickId  isJust kickId && fromJust kickId /= ci] 
1866  176 

4909  177 

11032  178 
handleCmd_lobby ["BAN", banNick, reason, duration] = serverAdminOnly $ do 
4909  179 
(ci, _) < ask 
180 
banId < clientByNick banNick 

11032  181 
return [BanClient (readInt_ duration) reason (fromJust banId)  isJust banId && fromJust banId /= ci] 
7321
57bd4f201401
 Try sending remove message in 'finally' as a last resort
unc0rr
parents:
6912
diff
changeset

182 

11032  183 
handleCmd_lobby ["BANIP", ip, reason, duration] = serverAdminOnly $ 
184 
return [BanIP ip (readInt_ duration) reason] 

7321
57bd4f201401
 Try sending remove message in 'finally' as a last resort
unc0rr
parents:
6912
diff
changeset

185 

11032  186 
handleCmd_lobby ["BANNICK", n, reason, duration] = serverAdminOnly $ 
187 
return [BanNick n (readInt_ duration) reason] 

8154  188 

11032  189 
handleCmd_lobby ["BANLIST"] = serverAdminOnly $ 
190 
return [BanList] 

1804  191 

3283  192 

11032  193 
handleCmd_lobby ["UNBAN", entry] = serverAdminOnly $ 
194 
return [Unban entry] 

7748  195 

196 

11032  197 
handleCmd_lobby ["SET_SERVER_VAR", "MOTD_NEW", newMessage] = serverAdminOnly $ 
198 
return [ModifyServerInfo (\si > si{serverMessage = newMessage})] 

1925  199 

11032  200 
handleCmd_lobby ["SET_SERVER_VAR", "MOTD_OLD", newMessage] = serverAdminOnly $ 
201 
return [ModifyServerInfo (\si > si{serverMessageForOldVersions = newMessage})] 

3260
b44b88908758
Allow to set motd for old client versions (not used yet, as server needs some refactoring)
unc0rr
parents:
2961
diff
changeset

202 

11032  203 
handleCmd_lobby ["SET_SERVER_VAR", "LATEST_PROTO", protoNum] = serverAdminOnly $ 
204 
return [ModifyServerInfo (\si > si{latestReleaseVersion = readNum})  readNum > 0] 

3260
b44b88908758
Allow to set motd for old client versions (not used yet, as server needs some refactoring)
unc0rr
parents:
2961
diff
changeset

205 
where 
5030
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4989
diff
changeset

206 
readNum = readInt_ protoNum 
7321
57bd4f201401
 Try sending remove message in 'finally' as a last resort
unc0rr
parents:
6912
diff
changeset

207 

11032  208 
handleCmd_lobby ["GET_SERVER_VAR"] = serverAdminOnly $ 
209 
return [SendServerVars] 

3283  210 

11032  211 
handleCmd_lobby ["CLEAR_ACCOUNTS_CACHE"] = serverAdminOnly $ 
212 
return [ClearAccountsCache] 

3283  213 

11032  214 
handleCmd_lobby ["RESTART_SERVER"] = serverAdminOnly $ 
215 
return [RestartServer] 

4914  216 

11032  217 
handleCmd_lobby ["STATS"] = serverAdminOnly $ 
218 
return [Stats] 

3283  219 

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

220 
handleCmd_lobby _ = return [ProtocolError "Incorrect command (state: in lobby)"] 