--- a/gameServer/Actions.hs Wed Oct 17 23:33:33 2012 +0400
+++ b/gameServer/Actions.hs Wed Oct 17 23:50:28 2012 +0400
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP, OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
module Actions where
import Control.Concurrent
@@ -20,7 +21,9 @@
import System.Process
import Network.Socket
-----------------------------
+#if defined(OFFICIAL_SERVER)
import OfficialServer.GameReplayStore
+#endif
import CoreTypes
import Utils
import ClientIO
@@ -222,7 +225,7 @@
(Just ci) <- gets clientIndex
ri <- clientRoomA
rnc <- gets roomsClients
- (gameProgress, playersNum) <- io $ room'sM rnc ((isJust . gameInfo) &&& playersIn) ri
+ playersNum <- io $ room'sM rnc playersIn ri
master <- client's isMaster
-- client <- client's id
clNick <- client's nick
@@ -266,10 +269,9 @@
, AnswerClients thisRoomChans ["CLIENT_FLAGS", "+h", nick newMaster]
]
- proto <- client's clientProto
- newRoom <- io $ room'sM rnc id ri
+ newRoom' <- io $ room'sM rnc id ri
chans <- liftM (map sendChan) $! sameProtoClientsS proto
- processAction $ AnswerClients chans ("ROOM" : "UPD" : oldRoomName : roomInfo newRoomName newRoom)
+ processAction $ AnswerClients chans ("ROOM" : "UPD" : oldRoomName : roomInfo newRoomName newRoom')
processAction (AddRoom roomName roomPassword) = do
@@ -317,10 +319,8 @@
processAction UnreadyRoomClients = do
- rnc <- gets roomsClients
ri <- clientRoomA
roomPlayers <- roomClientsS ri
- roomClIDs <- io $ roomClientsIndicesM rnc ri
pr <- client's clientProto
mapM_ processAction [
AnswerClients (map sendChan roomPlayers) $ notReadyMessage pr (map nick roomPlayers)
@@ -335,7 +335,6 @@
rnc <- gets roomsClients
ri <- clientRoomA
thisRoomChans <- liftM (map sendChan) $ roomClientsS ri
- clNick <- client's nick
answerRemovedTeams <- io $
room'sM rnc (map (\t -> AnswerClients thisRoomChans ["REMOVE_TEAM", t]) . leftTeams . fromJust . gameInfo) ri
@@ -488,9 +487,9 @@
processAction BanList = do
ch <- client's sendChan
- bans <- gets (B.pack . unlines . map show . bans . serverInfo)
+ b <- gets (B.pack . unlines . map show . bans . serverInfo)
processAction $
- AnswerClients [ch] ["BANLIST", bans]
+ AnswerClients [ch] ["BANLIST", b]
processAction (Unban entry) = do
processAction $ ModifyServerInfo (\s -> s{bans = filter f $ bans s})
--- a/gameServer/CoreTypes.hs Wed Oct 17 23:33:33 2012 +0400
+++ b/gameServer/CoreTypes.hs Wed Oct 17 23:50:28 2012 +0400
@@ -76,7 +76,12 @@
giParams :: Map.Map B.ByteString [B.ByteString]
} deriving (Show, Read)
---newGameInfo :: -> GameInfo
+newGameInfo :: [TeamInfo]
+ -> Int
+ -> Bool
+ -> Map.Map ByteString ByteString
+ -> Map.Map ByteString [ByteString]
+ -> GameInfo
newGameInfo =
GameInfo
Data.Sequence.empty
--- a/gameServer/EngineInteraction.hs Wed Oct 17 23:33:33 2012 +0400
+++ b/gameServer/EngineInteraction.hs Wed Oct 17 23:50:28 2012 +0400
@@ -1,7 +1,6 @@
module EngineInteraction where
import qualified Data.Set as Set
-import qualified Data.List as List
import Control.Monad
import qualified Codec.Binary.Base64 as Base64
import qualified Data.ByteString.Char8 as B
@@ -31,6 +30,7 @@
legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sNpPwtghbc12345" ++ slotMessages
slotMessages = "\128\129\130\131\132\133\134\135\136\137\138"
+
gameInfo2Replay :: GameInfo -> B.ByteString
gameInfo2Replay GameInfo{roundMsgs = rm,
teamsAtStart = teams,
--- a/gameServer/HWProtoCore.hs Wed Oct 17 23:33:33 2012 +0400
+++ b/gameServer/HWProtoCore.hs Wed Oct 17 23:50:28 2012 +0400
@@ -51,7 +51,7 @@
let clRoom = room rnc roomId
let roomMasterSign = if isMaster cl then "@" else ""
let adminSign = if isAdministrator cl then "@" else ""
- let roomInfo = if roomId /= lobbyId then B.concat [roomMasterSign, "room ", name clRoom] else adminSign `B.append` "lobby"
+ let rInfo = if roomId /= lobbyId then B.concat [roomMasterSign, "room ", name clRoom] else adminSign `B.append` "lobby"
let roomStatus = if isJust $ gameInfo clRoom then
if teamsInGame cl > 0 then "(playing)" else "(spectating)"
else
@@ -65,7 +65,7 @@
nick cl,
B.concat ["[", hostStr, "]"],
protoNumber2ver $ clientProto cl,
- B.concat ["[", roomInfo, "]", roomStatus]
+ B.concat ["[", rInfo, "]", roomStatus]
]
--- a/gameServer/HWProtoInRoomState.hs Wed Oct 17 23:33:33 2012 +0400
+++ b/gameServer/HWProtoInRoomState.hs Wed Oct 17 23:50:28 2012 +0400
@@ -2,7 +2,7 @@
module HWProtoInRoomState where
import qualified Data.Map as Map
-import Data.Sequence((|>), empty)
+import Data.Sequence((|>))
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as B
--- a/gameServer/HWProtoLobbyState.hs Wed Oct 17 23:33:33 2012 +0400
+++ b/gameServer/HWProtoLobbyState.hs Wed Oct 17 23:50:28 2012 +0400
@@ -131,7 +131,6 @@
handleCmd_lobby ["FOLLOW", asknick] = do
(_, rnc) <- ask
ci <- clientByNick asknick
- cl <- thisClient
let ri = clientRoom rnc $ fromJust ci
let clRoom = room rnc ri
if isNothing ci || ri == lobbyId then
@@ -156,18 +155,15 @@
return [BanClient 60 reason (fromJust banId) | isAdministrator cl && isJust banId && fromJust banId /= ci]
handleCmd_lobby ["BANIP", ip, reason, duration] = do
- (ci, _) <- ask
cl <- thisClient
return [BanIP ip (readInt_ duration) reason | isAdministrator cl]
handleCmd_lobby ["BANLIST"] = do
- (ci, _) <- ask
cl <- thisClient
return [BanList | isAdministrator cl]
handleCmd_lobby ["UNBAN", entry] = do
- (ci, _) <- ask
cl <- thisClient
return [Unban entry | isAdministrator cl]
--- a/gameServer/NetRoutines.hs Wed Oct 17 23:33:33 2012 +0400
+++ b/gameServer/NetRoutines.hs Wed Oct 17 23:50:28 2012 +0400
@@ -3,7 +3,6 @@
import Network.Socket
import Control.Concurrent.Chan
-import qualified Control.Exception as Exception
import Data.Time
import Control.Monad
import Data.Unique
--- a/gameServer/ServerCore.hs Wed Oct 17 23:33:33 2012 +0400
+++ b/gameServer/ServerCore.hs Wed Oct 17 23:50:28 2012 +0400
@@ -1,6 +1,5 @@
module ServerCore where
-import Network
import Control.Concurrent
import Control.Monad
import System.Log.Logger
--- a/gameServer/Utils.hs Wed Oct 17 23:33:33 2012 +0400
+++ b/gameServer/Utils.hs Wed Oct 17 23:50:28 2012 +0400
@@ -4,19 +4,16 @@
import Data.Char
import Data.Word
import qualified Data.Map as Map
-import qualified Data.Set as Set
import qualified Data.Char as Char
import Numeric
import Network.Socket
import System.IO
import qualified Data.List as List
import Control.Monad
-import qualified Codec.Binary.Base64 as Base64
import qualified Data.ByteString.Lazy as BL
import qualified Text.Show.ByteString as BS
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.UTF8 as UTF8
-import qualified Data.ByteString as BW
import Data.Maybe
-------------------------------------------------
import CoreTypes
@@ -123,6 +120,8 @@
where
f = map Char.toUpper . UTF8.toString
+
+roomInfo :: B.ByteString -> RoomInfo -> [B.ByteString]
roomInfo n r = [
showB $ isJust $ gameInfo r,
name r,