--- a/gameServer/HWProtoCore.hs Sun Oct 28 15:18:26 2012 +0100
+++ b/gameServer/HWProtoCore.hs Fri Dec 06 22:20:53 2019 +0100
@@ -1,3 +1,21 @@
+{-
+ * Hedgewars, a free turn based strategy game
+ * Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; version 2 of the License
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ \-}
+
{-# LANGUAGE OverloadedStrings #-}
module HWProtoCore where
@@ -6,15 +24,16 @@
import qualified Data.ByteString.Char8 as B
--------------------------------------
import CoreTypes
-import Actions
import HWProtoNEState
import HWProtoLobbyState
import HWProtoInRoomState
+import HWProtoChecker
import HandlerUtils
import RoomsAndClients
import Utils
+import Consts
-handleCmd, handleCmd_loggedin :: CmdHandler
+handleCmd, handleCmd_loggedin, handleCmd_lobbyOnly, handleCmd_roomOnly :: CmdHandler
handleCmd ["PING"] = answerClient ["PONG"]
@@ -22,7 +41,9 @@
handleCmd ("QUIT" : xs) = return [ByeClient msg]
where
- msg = if not $ null xs then head xs else "bye"
+ -- "bye" is a special string (do not translate!) when the user quits manually,
+ -- otherwise there will be an additional server message
+ msg = if not $ null xs then (head xs) else "bye"
handleCmd ["PONG"] = do
@@ -34,11 +55,87 @@
handleCmd cmd = do
(ci, irnc) <- ask
- if logonPassed (irnc `client` ci) then
- handleCmd_loggedin cmd
+ let cl = irnc `client` ci
+ if logonPassed cl then
+ if isChecker cl then
+ handleCmd_checker cmd
+ else
+ handleCmd_loggedin cmd
else
handleCmd_NotEntered cmd
+handleCmd_lobbyOnly cmd = do
+ (ci, rnc) <- ask
+ if (clientRoom rnc ci) == lobbyId then
+ handleCmd cmd
+ else
+ return [Warning $ loc "This command is only available in the lobby."]
+
+handleCmd_roomOnly cmd = do
+ (ci, rnc) <- ask
+ if (clientRoom rnc ci) == lobbyId then
+ return [Warning $ loc "This command is only available in rooms."]
+ else
+ handleCmd cmd
+
+-- Chat command handling
+unknownCmdWarningText :: B.ByteString
+unknownCmdWarningText = loc "Unknown command or invalid parameters. Say '/help' in chat for a list of commands."
+
+handleCmd_loggedin ["CMD"] = return [Warning unknownCmdWarningText]
+
+handleCmd_loggedin ["CMD", parameters] = uncurry h $ extractParameters parameters
+ where
+ -- room-only commands
+ h "DELEGATE" n | not $ B.null n = handleCmd_roomOnly ["DELEGATE", n]
+ h "SAVEROOM" n | not $ B.null n = handleCmd_roomOnly ["SAVEROOM", n]
+ h "LOADROOM" n | not $ B.null n = handleCmd_roomOnly ["LOADROOM", n]
+ h "SAVE" n | not $ B.null n = let (sn, ln) = B.break (== ' ') n in if B.null ln then return [Warning unknownCmdWarningText] else handleCmd_roomOnly ["SAVE", sn, B.tail ln]
+ h "DELETE" n | not $ B.null n = handleCmd_roomOnly ["DELETE", n]
+ h "FIX" _ = handleCmd_roomOnly ["FIX"]
+ h "UNFIX" _ = handleCmd_roomOnly ["UNFIX"]
+ h "GREETING" msg = handleCmd_roomOnly ["GREETING", msg]
+ h "CALLVOTE" msg | B.null msg = handleCmd_roomOnly ["CALLVOTE"]
+ | otherwise = let (c, p) = extractParameters msg in
+ if B.null p then handleCmd_roomOnly ["CALLVOTE", c] else handleCmd_roomOnly ["CALLVOTE", c, p]
+ h "VOTE" msg | not $ B.null msg = handleCmd_roomOnly ["VOTE", upperCase msg]
+ | otherwise = handleCmd_roomOnly ["VOTE", ""]
+ h "FORCE" msg | not $ B.null msg = handleCmd_roomOnly ["VOTE", upperCase msg, "FORCE"]
+ | otherwise = handleCmd_roomOnly ["VOTE", "", "FORCE"]
+ h "MAXTEAMS" n | not $ B.null n = handleCmd_roomOnly ["MAXTEAMS", n]
+ | otherwise = handleCmd_roomOnly ["MAXTEAMS"]
+
+ -- lobby-only commands
+ h "STATS" _ = handleCmd_lobbyOnly ["STATS"]
+ h "RESTART_SERVER" p = handleCmd_lobbyOnly ["RESTART_SERVER", upperCase p]
+
+ -- room and lobby commands
+ h "QUIT" _ = handleCmd ["QUIT"]
+ h "RND" p = handleCmd ("RND" : B.words p)
+ h "GLOBAL" p = serverAdminOnly $ do
+ rnc <- liftM snd ask
+ let chans = map (sendChan . client rnc) $ allClients rnc
+ return [AnswerClients chans ["CHAT", nickGlobal, p]]
+ h "WATCH" f = return [QueryReplay f]
+ h "INFO" n | not $ B.null n = handleCmd ["INFO", n]
+ h "HELP" _ = handleCmd ["HELP"]
+ h "REGISTERED_ONLY" _ = serverAdminOnly $ do
+ rnc <- liftM snd ask
+ let chans = map (sendChan . client rnc) $ allClients rnc
+ return
+ [ModifyServerInfo(\s -> s{isRegisteredUsersOnly = not $ isRegisteredUsersOnly s})
+ , ShowRegisteredOnlyState chans
+ ]
+ h "SUPER_POWER" _ = serverAdminOnly $ do
+ cl <- thisClient
+ return
+ [ModifyClient (\c -> c{hasSuperPower = True})
+ , AnswerClients [sendChan cl] ["CHAT", nickServer, loc "Super power activated."]
+ ]
+ h _ _ = return [Warning unknownCmdWarningText]
+
+
+ extractParameters p = let (a, b) = B.break (== ' ') p in (upperCase a, B.dropWhile (== ' ') b)
handleCmd_loggedin ["INFO", asknick] = do
(_, rnc) <- ask
@@ -49,16 +146,16 @@
let cl = rnc `client` fromJust maybeClientId
let roomId = clientRoom rnc clientId
let clRoom = room rnc roomId
- let roomMasterSign = if isMaster cl then "@" else ""
+ let roomMasterSign = if isMaster cl then "+" else ""
let adminSign = if isAdministrator cl then "@" else ""
- let rInfo = if roomId /= lobbyId then B.concat [roomMasterSign, "room ", name clRoom] else adminSign `B.append` "lobby"
+ let rInfo = if roomId /= lobbyId then B.concat [adminSign, roomMasterSign, loc "room", " ", name clRoom] else adminSign `B.append` (loc "lobby")
let roomStatus = if isJust $ gameInfo clRoom then
- if teamsInGame cl > 0 then "(playing)" else "(spectating)"
+ if teamsInGame cl > 0 then (loc "(playing)") else (loc "(spectating)")
else
""
- let hostStr = if isAdminAsking then host cl else cutHost $ host cl
+ let hostStr = if isAdminAsking then host cl else B.empty
if noSuchClient then
- return []
+ answerClient [ "CHAT", nickServer, loc "Player is not online." ]
else
answerClient [
"INFO",