gameServer/EngineInteraction.hs
author Mitchell Kember <mk12360@gmail.com>
Thu, 29 Nov 2012 19:44:18 -0500
changeset 8144 f3ba33d5d2b1
parent 7766 98edc0724a28
child 8479 8d71109b04d2
permissions -rw-r--r--
Google Code-in: Hide "video record" keybind option Removes the recording keybinding option using preprocessor conditions when it is unavailable. This includes when Hedgewars is being built either with the recording feature explicitly disabled or when FFMPEG/LibAV were not found. https://google-melange.appspot.com/gci/task/view/google/gci2012/7948213
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
6069
d59745e525ec GameInfo needs room params copy
unc0rr
parents: 6068
diff changeset
     8
-------------
d59745e525ec GameInfo needs room params copy
unc0rr
parents: 6068
diff changeset
     9
import CoreTypes
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    10
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    11
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    12
toEngineMsg :: B.ByteString -> B.ByteString
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    13
toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : BW.unpack msg)
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    14
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    15
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    16
fromEngineMsg :: B.ByteString -> Maybe B.ByteString
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    17
fromEngineMsg msg = liftM BW.pack (Base64.decode (B.unpack msg) >>= removeLength)
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    18
    where
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    19
        removeLength (x:xs) = if length xs == fromIntegral x then Just xs else Nothing
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    20
        removeLength _ = Nothing
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    21
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    22
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    23
checkNetCmd :: B.ByteString -> (Bool, Bool)
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    24
checkNetCmd msg = check decoded
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    25
    where
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    26
        decoded = fromEngineMsg msg
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    27
        check Nothing = (False, False)
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    28
        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
    29
                        | 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
    30
        legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sNpPwtghbc12345" ++ slotMessages
6068
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    31
        slotMessages = "\128\129\130\131\132\133\134\135\136\137\138"
e18713ecf1e0 Introduce EngineInteraction module
unc0rr
parents:
diff changeset
    32
7766
98edc0724a28 Fix most of server warnings
unc0rr
parents: 6206
diff changeset
    33
6069
d59745e525ec GameInfo needs room params copy
unc0rr
parents: 6068
diff changeset
    34
gameInfo2Replay :: GameInfo -> B.ByteString
d59745e525ec GameInfo needs room params copy
unc0rr
parents: 6068
diff changeset
    35
gameInfo2Replay GameInfo{roundMsgs = rm,
d59745e525ec GameInfo needs room params copy
unc0rr
parents: 6068
diff changeset
    36
        teamsAtStart = teams,
6070
429b4637c8ad Oops, fix build
unc0rr
parents: 6069
diff changeset
    37
        giMapParams = params1,
429b4637c8ad Oops, fix build
unc0rr
parents: 6069
diff changeset
    38
        giParams = params2} = undefined