# HG changeset patch
# User unc0rr
# Date 1390424657 -14400
# Node ID 4ed428389c4edec907a3e2bcb9602ba8dba5dea2
# Parent  795f5f918c8c26deefc20f500ba096b1fe6e9b2e
 - Implement /callvote

diff -r 795f5f918c8c -r 4ed428389c4e gameServer/Actions.hs
--- 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
diff -r 795f5f918c8c -r 4ed428389c4e gameServer/CoreTypes.hs
--- 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 =
diff -r 795f5f918c8c -r 4ed428389c4e gameServer/EngineInteraction.hs
--- 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
diff -r 795f5f918c8c -r 4ed428389c4e gameServer/HWProtoInRoomState.hs
--- 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
diff -r 795f5f918c8c -r 4ed428389c4e gameServer/Votes.hs
--- 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]
+