# HG changeset patch # User EJ # Date 1300730660 -10800 # Node ID 42746c5d4a80469a831aedf1bb2073fc63f0e07c # Parent 3c43f00b0743ac9b82fdf17021a2548363993a26 Changed the standard show function to Text.Show.ByteString, and misc. ByteString related changes in gameServer. diff -r 3c43f00b0743 -r 42746c5d4a80 gameServer/Actions.hs --- a/gameServer/Actions.hs Sun Mar 20 08:42:32 2011 +0000 +++ b/gameServer/Actions.hs Mon Mar 21 21:04:20 2011 +0300 @@ -103,7 +103,7 @@ vars si = [ "MOTD_NEW", serverMessage si, "MOTD_OLD", serverMessageForOldVersions si, - "LATEST_PROTO", B.pack . show $ latestReleaseVersion si + "LATEST_PROTO", showB $ latestReleaseVersion si ] @@ -118,7 +118,7 @@ processAction (NoticeMessage n) = do chan <- client's sendChan - processAction $ AnswerClients [chan] ["NOTICE", B.pack . show . fromEnum $ n] + processAction $ AnswerClients [chan] ["NOTICE", showB . fromEnum $ n] processAction (ByeClient msg) = do (Just ci) <- gets clientIndex @@ -301,7 +301,7 @@ }) ] where - rmTeamMsg = toEngineMsg $ B.singleton 'F' `B.append` teamName + rmTeamMsg = toEngineMsg $ 'F' `B.cons` teamName processAction (RemoveClientTeams clId) = do @@ -376,7 +376,7 @@ modify (\s -> s{clientIndex = Just banId}) clHost <- client's host currentTime <- io getCurrentTime - let msg = "Ban for " `B.append` (B.pack . show $ seconds) `B.append` "seconds (" `B.append` reason ` B.append` ")" + let msg = B.concat ["Ban for ", B.pack . show $ seconds, "seconds (", reason, ")"] mapM_ processAction [ AddIP2Bans clHost msg (addUTCTime seconds currentTime) , KickClient banId diff -r 3c43f00b0743 -r 42746c5d4a80 gameServer/ClientIO.hs --- a/gameServer/ClientIO.hs Sun Mar 20 08:42:32 2011 +0000 +++ b/gameServer/ClientIO.hs Mon Mar 21 21:04:20 2011 +0300 @@ -15,7 +15,7 @@ pDelim :: B.ByteString -pDelim = B.pack "\n\n" +pDelim = "\n\n" bs2Packets :: B.ByteString -> ([[B.ByteString]], B.ByteString) bs2Packets = unfoldrE extractPackets @@ -59,7 +59,7 @@ answer <- readChan chan Exception.handle (\(e :: Exception.IOException) -> unless (isQuit answer) . killReciever $ show e) $ - sendAll s $ B.unlines answer `B.append` B.singleton '\n' + sendAll s $ B.unlines answer `B.snoc` '\n' if isQuit answer then do diff -r 3c43f00b0743 -r 42746c5d4a80 gameServer/HWProtoCore.hs --- a/gameServer/HWProtoCore.hs Sun Mar 20 08:42:32 2011 +0000 +++ b/gameServer/HWProtoCore.hs Mon Mar 21 21:04:20 2011 +0300 @@ -50,7 +50,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 roomMasterSign `B.append` "room " `B.append` name clRoom else adminSign `B.append` "lobby" + let roomInfo = if roomId /= lobbyId then B.concat [roomMasterSign, "room ", name clRoom] else adminSign `B.append` "lobby" let roomStatus = if gameinprogress clRoom then if teamsInGame cl > 0 then "(playing)" else "(spectating)" else @@ -61,9 +61,9 @@ answerClient [ "INFO", nick cl, - "[" `B.append` host cl `B.append` "]", + B.concat ["[", host cl, "]"], protoNumber2ver $ clientProto cl, - "[" `B.append` roomInfo `B.append` "]" `B.append` roomStatus + B.concat ["[", roomInfo, "]", roomStatus] ] diff -r 3c43f00b0743 -r 42746c5d4a80 gameServer/HWProtoInRoomState.hs --- a/gameServer/HWProtoInRoomState.hs Sun Mar 20 08:42:32 2011 +0000 +++ b/gameServer/HWProtoInRoomState.hs Mon Mar 21 21:04:20 2011 +0300 @@ -73,9 +73,7 @@ canAddNumber r = 48 - (sum . map hhnum $ teams r) findTeam = find (\t -> tName == teamname t) . teams newTeam ci clNick r = TeamInfo ci clNick tName color grave fort voicepack flag dif (newTeamHHNum r) (hhsList hhsInfo) - dif = case B.readInt difStr of - Just (i, t) | B.null t -> fromIntegral i - _ -> 0 + dif = readInt_ difStr hhsList [] = [] hhsList [_] = error "Hedgehogs list with odd elements number" hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs @@ -122,11 +120,9 @@ [] else [ModifyRoom $ modifyTeam team{hhnum = hhNumber}, - AnswerClients others ["HH_NUM", teamName, B.pack $ show hhNumber]] + AnswerClients others ["HH_NUM", teamName, showB hhNumber]] where - hhNumber = case B.readInt numberStr of - Just (i, t) | B.null t -> fromIntegral i - _ -> 0 + hhNumber = readInt_ numberStr findTeam = find (\t -> teamName == teamname t) . teams canAddNumber = (-) 48 . sum . map hhnum . teams @@ -261,6 +257,6 @@ chans <- roomSameClanChans return [AnswerClients chans ["EM", engineMsg cl]] where - engineMsg cl = toEngineMsg $ "b" `B.append` nick cl `B.append` "(team): " `B.append` msg `B.append` "\x20\x20" + engineMsg cl = toEngineMsg $ B.concat ["b", nick cl, "(team): ", msg, "\x20\x20"] handleCmd_inRoom _ = return [ProtocolError "Incorrect command (state: in room)"] diff -r 3c43f00b0743 -r 42746c5d4a80 gameServer/HWProtoLobbyState.hs --- a/gameServer/HWProtoLobbyState.hs Sun Mar 20 08:42:32 2011 +0000 +++ b/gameServer/HWProtoLobbyState.hs Mon Mar 21 21:04:20 2011 +0300 @@ -22,7 +22,7 @@ toAnswer team = [AnswerClients [clChan] $ teamToNet team, AnswerClients [clChan] ["TEAM_COLOR", teamname team, teamcolor team], - AnswerClients [clChan] ["HH_NUM", teamname team, B.pack . show $ hhnum team]] + AnswerClients [clChan] ["HH_NUM", teamname team, showB $ hhnum team]] handleCmd_lobby :: CmdHandler @@ -169,10 +169,8 @@ cl <- thisClient return [ModifyServerInfo (\si -> si{latestReleaseVersion = readNum}) | isAdministrator cl && readNum > 0] where - readNum = case B.readInt protoNum of - Just (i, t) | B.null t -> fromIntegral i - _ -> 0 - + readNum = readInt_ protoNum + handleCmd_lobby ["GET_SERVER_VAR"] = do cl <- thisClient return [SendServerVars | isAdministrator cl] diff -r 3c43f00b0743 -r 42746c5d4a80 gameServer/HWProtoNEState.hs --- a/gameServer/HWProtoNEState.hs Sun Mar 20 08:42:32 2011 +0000 +++ b/gameServer/HWProtoNEState.hs Mon Mar 21 21:04:20 2011 +0300 @@ -32,7 +32,7 @@ else return $ ModifyClient (\c -> c{clientProto = parsedProto}) : - AnswerClients [sendChan cl] ["PROTO", B.pack $ show parsedProto] : + AnswerClients [sendChan cl] ["PROTO", showB parsedProto] : [CheckRegistered | not . B.null $ nick cl] where parsedProto = case B.readInt protoNum of diff -r 3c43f00b0743 -r 42746c5d4a80 gameServer/Utils.hs --- a/gameServer/Utils.hs Sun Mar 20 08:42:32 2011 +0000 +++ b/gameServer/Utils.hs Mon Mar 21 21:04:20 2011 +0300 @@ -11,6 +11,8 @@ 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 as BW ------------------------------------------------- @@ -34,11 +36,12 @@ removeLength _ = Nothing checkNetCmd :: B.ByteString -> (Bool, Bool) -checkNetCmd = check . liftM B.unpack . fromEngineMsg +checkNetCmd msg = check decoded where + decoded = fromEngineMsg msg check Nothing = (False, False) - check (Just (m:_)) = (m `Set.member` legalMessages, m == '+') - check _ = (False, False) + check (Just ms) | B.length ms > 0 = let m = B.head ms in (m `Set.member` legalMessages, m == '+') + | otherwise = (False, False) legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sFNpPwtghbc12345" ++ slotMessages slotMessages = "\128\129\130\131\132\133\134\135\136\137\138" @@ -56,7 +59,7 @@ : teamvoicepack team : teamflag team : teamowner team - : (B.pack . show $ difficulty team) + : (showB . difficulty $ team) : hhsInfo where hhsInfo = concatMap (\(HedgehogInfo n hat) -> [n, hat]) $ hedgehogs team @@ -72,9 +75,7 @@ t : replaceTeam tm ts illegalName :: B.ByteString -> Bool -illegalName b = null s || all isSpace s || isSpace (head s) || isSpace (last s) - where - s = B.unpack b +illegalName s = B.null s || B.all isSpace s || isSpace (B.head s) || isSpace (B.last s) protoNumber2ver :: Word16 -> B.ByteString protoNumber2ver v = Map.findWithDefault "Unknown" v vermap @@ -115,5 +116,11 @@ Right (a, new_b) -> let (a', b') = unfoldrE f new_b in (a : a', b') Left new_b -> ([], new_b) -showB :: Show a => a -> B.ByteString -showB = B.pack .show +showB :: (BS.Show a) => a -> B.ByteString +showB = B.concat . BL.toChunks . BS.show + +readInt_ :: (Num a) => B.ByteString -> a +readInt_ str = + case B.readInt str of + Just (i, t) | B.null t -> fromIntegral i + _ -> 0 diff -r 3c43f00b0743 -r 42746c5d4a80 gameServer/hedgewars-server.cabal --- a/gameServer/hedgewars-server.cabal Sun Mar 20 08:42:32 2011 +0000 +++ b/gameServer/hedgewars-server.cabal Mon Mar 21 21:04:20 2011 +0300 @@ -20,6 +20,7 @@ containers, array, bytestring, + bytestring-show, network-bytestring, network, time,