--- a/gameServer/Actions.hs Thu Jan 23 00:07:27 2014 +0400
+++ b/gameServer/Actions.hs Thu Jan 23 01:04:17 2014 +0400
@@ -222,7 +222,7 @@
rnc <- gets roomsClients
specialRoom <- io $ room'sM rnc isSpecial ri
newMasterId <- if specialRoom then
- delegateId
+ return delegateId
else
liftM (\ids -> fromMaybe (listToMaybe . reverse . filter (/= ci) $ ids) $ liftM Just delegateId) . io $ roomClientsIndicesM rnc ri
newMaster <- io $ client'sM rnc id `DT.mapM` newMasterId
--- a/gameServer/CoreTypes.hs Thu Jan 23 00:07:27 2014 +0400
+++ b/gameServer/CoreTypes.hs Thu Jan 23 01:04:17 2014 +0400
@@ -277,8 +277,8 @@
data VoteType = VoteKick B.ByteString
-newVote :: VoteType -> Voting
-newVote = Voting 2 [] []
+newVoting :: VoteType -> Voting
+newVoting = Voting 2 [] []
data AccountInfo =
--- a/gameServer/EngineInteraction.hs Thu Jan 23 00:07:27 2014 +0400
+++ b/gameServer/EngineInteraction.hs Thu Jan 23 01:04:17 2014 +0400
@@ -24,13 +24,12 @@
because standard 'catch' doesn't seem to catch decompression errors for some reason
-}
import qualified Codec.Compression.Zlib.Internal as Z
-import Control.Arrow (right)
decompressWithoutExceptions :: BL.ByteString -> Either Z.DecompressError BL.ByteString
decompressWithoutExceptions = finalise
. Z.foldDecompressStream cons nil err
. Z.decompressWithErrors Z.gzipFormat Z.defaultDecompressParams
- where err errorCode errorString = Left errorCode
+ where err errorCode _ = Left errorCode
nil = Right []
cons chunk = right (chunk :)
finalise = right BL.fromChunks
@@ -40,11 +39,11 @@
toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : BW.unpack msg)
-fromEngineMsg :: B.ByteString -> Maybe B.ByteString
+{-fromEngineMsg :: B.ByteString -> Maybe B.ByteString
fromEngineMsg msg = liftM BW.pack (Base64.decode (B.unpack msg) >>= removeLength)
where
removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing
- removeLength _ = Nothing
+ removeLength _ = Nothing-}
em :: B.ByteString -> B.ByteString
em = toEngineMsg
--- a/gameServer/HWProtoInRoomState.hs Thu Jan 23 00:07:27 2014 +0400
+++ b/gameServer/HWProtoInRoomState.hs Thu Jan 23 01:04:17 2014 +0400
@@ -408,14 +408,18 @@
handleCmd_inRoom ["CALLVOTE", "KICK", nickname] = do
(thisClientId, rnc) <- ask
cl <- thisClient
+ rm <- thisRoom
maybeClientId <- clientByNick nickname
let kickId = fromJust maybeClientId
let sameRoom = clientRoom rnc thisClientId == clientRoom rnc kickId
- if isJust maybeClientId && sameRoom then
- startVote $ VoteKick nickname
+ if isNothing $ masterID rm then
+ return []
else
- return [AnswerClients [sendChan cl] ["CHAT", "[server]", "callvote kick: no such user"]]
+ if isJust maybeClientId && sameRoom then
+ startVote $ VoteKick nickname
+ else
+ return [AnswerClients [sendChan cl] ["CHAT", "[server]", "callvote kick: no such user"]]
handleCmd_inRoom ["VOTE", m] = do
cl <- thisClient
--- a/gameServer/Votes.hs Thu Jan 23 00:07:27 2014 +0400
+++ b/gameServer/Votes.hs Thu Jan 23 01:04:17 2014 +0400
@@ -1,17 +1,40 @@
+{-# LANGUAGE OverloadedStrings #-}
module Votes where
import Data.Unique
-import CoreTypes
-import RoomsAndClients
import Control.Monad.Reader
import Control.Monad.State
import ServerState
+import qualified Data.ByteString.Char8 as B
+import Data.Maybe
+-------------------
+import Utils
+import CoreTypes
+import HandlerUtils
voted :: Unique -> Bool -> Reader (ClientIndex, IRnC) [Action]
-voted = undefined
+voted _ _ = do
+ return []
startVote :: VoteType -> Reader (ClientIndex, IRnC) [Action]
-startVote = undefined
+startVote vt = do
+ (ci, rnc) <- ask
+ cl <- thisClient
+ rm <- thisRoom
+ chans <- roomClientsChans
+
+ let uids = map (clUID . client rnc) . roomClients rnc $ clientRoom rnc ci
+
+ if isJust $ voting rm then
+ return []
+ else
+ liftM ([ModifyRoom (\r -> r{voting = Just (newVoting vt){entitledToVote = uids}})
+ , AnswerClients chans ["CHAT", "[server]", B.concat [loc "New voting started", ": ", voteInfo vt]]
+ ] ++ ) $ voted (clUID cl) True
checkVotes :: StateT ServerState IO ()
checkVotes = undefined
+
+voteInfo :: VoteType -> B.ByteString
+voteInfo (VoteKick n) = B.concat [loc "kick", " ", n]
+