sheepy-clone: gameServer/EngineInteraction.hs@42d2565b5700 (annotated)

8480 42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	1	{-# LANGUAGE OverloadedStrings #-}
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	2
6068 e18713ecf1e0 Introduce EngineInteraction module unc0rr parents: diff changeset	3	module EngineInteraction where
e18713ecf1e0 Introduce EngineInteraction module unc0rr parents: diff changeset	4
e18713ecf1e0 Introduce EngineInteraction module unc0rr parents: diff changeset	5	import qualified Data.Set as Set
e18713ecf1e0 Introduce EngineInteraction module unc0rr parents: diff changeset	6	import Control.Monad
e18713ecf1e0 Introduce EngineInteraction module unc0rr parents: diff changeset	7	import qualified Codec.Binary.Base64 as Base64
e18713ecf1e0 Introduce EngineInteraction module unc0rr parents: diff changeset	8	import qualified Data.ByteString.Char8 as B
e18713ecf1e0 Introduce EngineInteraction module unc0rr parents: diff changeset	9	import qualified Data.ByteString as BW
8479 8d71109b04d2 Some work on loading replay and interaction with checker unc0rr parents: 7766 diff changeset	10	import qualified Data.Map as Map
8480 42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	11	import Data.Word
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	12	import Data.Bits
6069 d59745e525ec GameInfo needs room params copy unc0rr parents: 6068 diff changeset	13	-------------
d59745e525ec GameInfo needs room params copy unc0rr parents: 6068 diff changeset	14	import CoreTypes
8480 42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	15	import Utils
6068 e18713ecf1e0 Introduce EngineInteraction module unc0rr parents: diff changeset	16
e18713ecf1e0 Introduce EngineInteraction module unc0rr parents: diff changeset	17
e18713ecf1e0 Introduce EngineInteraction module unc0rr parents: diff changeset	18	toEngineMsg :: B.ByteString -> B.ByteString
e18713ecf1e0 Introduce EngineInteraction module unc0rr parents: diff changeset	19	toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : BW.unpack msg)
e18713ecf1e0 Introduce EngineInteraction module unc0rr parents: diff changeset	20
e18713ecf1e0 Introduce EngineInteraction module unc0rr parents: diff changeset	21
e18713ecf1e0 Introduce EngineInteraction module unc0rr parents: diff changeset	22	fromEngineMsg :: B.ByteString -> Maybe B.ByteString
e18713ecf1e0 Introduce EngineInteraction module unc0rr parents: diff changeset	23	fromEngineMsg msg = liftM BW.pack (Base64.decode (B.unpack msg) >>= removeLength)
e18713ecf1e0 Introduce EngineInteraction module unc0rr parents: diff changeset	24	where
e18713ecf1e0 Introduce EngineInteraction module unc0rr parents: diff changeset	25	removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing
e18713ecf1e0 Introduce EngineInteraction module unc0rr parents: diff changeset	26	removeLength _ = Nothing
e18713ecf1e0 Introduce EngineInteraction module unc0rr parents: diff changeset	27
e18713ecf1e0 Introduce EngineInteraction module unc0rr parents: diff changeset	28
e18713ecf1e0 Introduce EngineInteraction module unc0rr parents: diff changeset	29	checkNetCmd :: B.ByteString -> (Bool, Bool)
e18713ecf1e0 Introduce EngineInteraction module unc0rr parents: diff changeset	30	checkNetCmd msg = check decoded
e18713ecf1e0 Introduce EngineInteraction module unc0rr parents: diff changeset	31	where
e18713ecf1e0 Introduce EngineInteraction module unc0rr parents: diff changeset	32	decoded = fromEngineMsg msg
e18713ecf1e0 Introduce EngineInteraction module unc0rr parents: diff changeset	33	check Nothing = (False, False)
e18713ecf1e0 Introduce EngineInteraction module unc0rr parents: diff changeset	34	check (Just ms) \| B.length ms > 0 = let m = B.head ms in (m `Set.member` legalMessages, m == '+')
e18713ecf1e0 Introduce EngineInteraction module unc0rr parents: diff changeset	35	\| otherwise = (False, False)
6206 75e0d8169ba2 As sheepluva pointed out, allowing this message to be legal allows naughtiness. The server usage of this message does not seem to use this check. nemo parents: 6070 diff changeset	36	legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sNpPwtghbc12345" ++ slotMessages
6068 e18713ecf1e0 Introduce EngineInteraction module unc0rr parents: diff changeset	37	slotMessages = "\128\129\130\131\132\133\134\135\136\137\138"
e18713ecf1e0 Introduce EngineInteraction module unc0rr parents: diff changeset	38
7766 98edc0724a28 Fix most of server warnings unc0rr parents: 6206 diff changeset	39
8479 8d71109b04d2 Some work on loading replay and interaction with checker unc0rr parents: 7766 diff changeset	40	replayToDemo :: [TeamInfo]
8d71109b04d2 Some work on loading replay and interaction with checker unc0rr parents: 7766 diff changeset	41	-> Map.Map B.ByteString B.ByteString
8d71109b04d2 Some work on loading replay and interaction with checker unc0rr parents: 7766 diff changeset	42	-> Map.Map B.ByteString [B.ByteString]
8d71109b04d2 Some work on loading replay and interaction with checker unc0rr parents: 7766 diff changeset	43	-> [B.ByteString]
8d71109b04d2 Some work on loading replay and interaction with checker unc0rr parents: 7766 diff changeset	44	-> [B.ByteString]
8480 42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	45	replayToDemo teams mapParams params msgs = concat [
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	46	[em "TD"]
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	47	, maybeScript
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	48	, maybeMap
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	49	, [eml ["etheme ", head $ params Map.! "THEME"]]
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	50	, [eml ["eseed ", mapParams Map.! "SEED"]]
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	51	, [eml ["e$gmflags ", showB gameFlags]]
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	52	, schemeFlags
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	53	, [eml ["e$template_filter ", mapParams Map.! "TEMPLATE"]]
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	54	, [eml ["e$mapgen ", mapParams Map.! "MAPGEN"]]
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	55	, msgs
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	56	]
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	57	where
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	58	em = toEngineMsg
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	59	eml = em . B.concat
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	60	mapGenTypes = ["+rnd+", "+maze+", "+drawn+"]
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	61	maybeScript = let s = head $ params Map.! "SCRIPT" in if s == "Normal" then [] else [eml ["escript Scripts/Multiplayer/", s, ".lua"]]
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	62	maybeMap = let m = mapParams Map.! "MAP" in if m `elem` mapGenTypes then [] else [eml ["emap ", m]]
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	63	scheme = tail $ params Map.! "SCHEME"
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	64	gameFlags :: Word32
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	65	gameFlags = foldl (\r (b, f) -> if b == "false" then r else r .\|. f) 0 $ zip scheme gameFlagConsts
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	66	schemeFlags = map (\(v, (n, m)) -> eml [n, " ", showB $ (readInt_ v) * m])
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	67	$ filter (\(_, (n, _)) -> not $ B.null n)
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	68	$ zip (drop (length gameFlagConsts) scheme) schemeParams
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	69
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	70
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	71	schemeParams :: [(B.ByteString, Int)]
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	72	schemeParams = [
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	73	("e$damagepct", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	74	, ("e$turntime", 1000)
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	75	, ("", 0)
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	76	, ("e$sd_turns", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	77	, ("e$casefreq", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	78	, ("e$minestime", 1000)
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	79	, ("e$minesnum", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	80	, ("e$minedudpct", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	81	, ("e$explosives", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	82	, ("e$healthprob", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	83	, ("e$hcaseamount", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	84	, ("e$waterrise", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	85	, ("e$healthdec", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	86	, ("e$ropepct", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	87	, ("e$getawaytime", 1)
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	88	]
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	89
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	90
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	91	gameFlagConsts :: [Word32]
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	92	gameFlagConsts = [
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	93	0x00001000
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	94	, 0x00000010
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	95	, 0x00000004
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	96	, 0x00000008
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	97	, 0x00000020
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	98	, 0x00000040
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	99	, 0x00000080
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	100	, 0x00000100
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	101	, 0x00000200
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	102	, 0x00000400
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	103	, 0x00000800
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	104	, 0x00002000
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	105	, 0x00004000
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	106	, 0x00008000
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	107	, 0x00010000
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	108	, 0x00020000
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	109	, 0x00040000
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	110	, 0x00080000
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	111	, 0x00100000
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	112	, 0x00200000
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	113	, 0x00400000
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	114	, 0x00800000
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	115	, 0x01000000
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	116	, 0x02000000
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	117	, 0x04000000
42d2565b5700 Converter from game parameters to engine commands, not finished yet unc0rr parents: 8479 diff changeset	118	]
8479 8d71109b04d2 Some work on loading replay and interaction with checker unc0rr parents: 7766 diff changeset	119
8d71109b04d2 Some work on loading replay and interaction with checker unc0rr parents: 7766 diff changeset	120
8d71109b04d2 Some work on loading replay and interaction with checker unc0rr parents: 7766 diff changeset	121

author	unc0rr
	Thu, 07 Feb 2013 00:07:32 +0400
changeset 8480	42d2565b5700
parent 8479	8d71109b04d2
child 8481	692ff6468b63
permissions	-rw-r--r--