gameServer/EngineInteraction.hs
author unc0rr
Mon, 04 Feb 2013 00:13:55 +0400
changeset 8479 8d71109b04d2
parent 7766 98edc0724a28
child 8480 42d2565b5700
permissions -rw-r--r--
Some work on loading replay and interaction with checker
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
     1
module EngineInteraction where
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
     2
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
     3
import qualified Data.Set as Set
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
     4
import Control.Monad
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
     5
import qualified Codec.Binary.Base64 as Base64
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
     6
import qualified Data.ByteString.Char8 as B
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
     7
import qualified Data.ByteString as BW
8479
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
     8
import qualified Data.Map as Map
6069
d59745e525ec GameInfo needs room params copy
unc0rr
parents: 6068
diff changeset
     9
-------------
d59745e525ec GameInfo needs room params copy
unc0rr
parents: 6068
diff changeset
    10
import CoreTypes
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    11
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    12
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    13
toEngineMsg :: B.ByteString -> B.ByteString
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    14
toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : BW.unpack msg)
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    15
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    16
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    17
fromEngineMsg :: B.ByteString -> Maybe B.ByteString
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    18
fromEngineMsg msg = liftM BW.pack (Base64.decode (B.unpack msg) >>= removeLength)
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    19
    where
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    20
        removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    21
        removeLength _ = Nothing
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    22
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    23
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    24
checkNetCmd :: B.ByteString -> (Bool, Bool)
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    25
checkNetCmd msg = check decoded
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    26
    where
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    27
        decoded = fromEngineMsg msg
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    28
        check Nothing = (False, False)
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    29
        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
    30
                        | 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
    31
        legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sNpPwtghbc12345" ++ slotMessages
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    32
        slotMessages = "\128\129\130\131\132\133\134\135\136\137\138"
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    33
7766
98edc0724a28 Fix most of server warnings
unc0rr
parents: 6206
diff changeset
    34
8479
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
    35
replayToDemo :: [TeamInfo]
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
    36
        -> Map.Map B.ByteString B.ByteString
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
    37
        -> Map.Map B.ByteString [B.ByteString]
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
    38
        -> [B.ByteString]
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
    39
        -> [B.ByteString]
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
    40
replayToDemo teams mapParams params msgs = undefined
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
    41
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
    42
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
    43
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 7766
diff changeset
    44