gameServer/EngineInteraction.hs
changeset 10055 f738693be9be
parent 10053 8a56c23f94c5
child 10058 4ed428389c4e
equal deleted inserted replaced
10054:6357b3099e1f 10055:f738693be9be
    17 import Codec.Compression.Zlib as Z
    17 import Codec.Compression.Zlib as Z
    18 -------------
    18 -------------
    19 import CoreTypes
    19 import CoreTypes
    20 import Utils
    20 import Utils
    21 
    21 
       
    22 {-
       
    23     this is snippet from http://stackoverflow.com/questions/10043102/how-to-catch-the-decompress-ioerror
       
    24     because standard 'catch' doesn't seem to catch decompression errors for some reason
       
    25 -}
       
    26 import qualified Codec.Compression.Zlib.Internal as Z
       
    27 import Control.Arrow (right)
       
    28 
       
    29 decompressWithoutExceptions :: BL.ByteString -> Either Z.DecompressError BL.ByteString
       
    30 decompressWithoutExceptions = finalise
       
    31                             . Z.foldDecompressStream cons nil err
       
    32                             . Z.decompressWithErrors Z.gzipFormat Z.defaultDecompressParams
       
    33   where err errorCode errorString = Left errorCode
       
    34         nil = Right []
       
    35         cons chunk = right (chunk :)
       
    36         finalise = right BL.fromChunks
       
    37 {- end snippet  -}
    22 
    38 
    23 toEngineMsg :: B.ByteString -> B.ByteString
    39 toEngineMsg :: B.ByteString -> B.ByteString
    24 toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : BW.unpack msg)
    40 toEngineMsg msg = B.pack $ Base64.encode (fromIntegral (BW.length msg) : BW.unpack msg)
    25 
    41 
    26 
    42 
    54                         else if '+' /= m' then Just Nothing else Just . Just . B.pack . Base64.encode . BW.unpack $ m
    70                         else if '+' /= m' then Just Nothing else Just . Just . B.pack . Base64.encode . BW.unpack $ m
    55         isNonEmpty = (/=) '+' . B.head . B.tail
    71         isNonEmpty = (/=) '+' . B.head . B.tail
    56         legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sNpPwtghbc12345" ++ slotMessages
    72         legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sNpPwtghbc12345" ++ slotMessages
    57         slotMessages = "\128\129\130\131\132\133\134\135\136\137\138"
    73         slotMessages = "\128\129\130\131\132\133\134\135\136\137\138"
    58         timedMessages = Set.fromList $ "+LlRrUuDdZzAaSjJ,NpPwtgc12345" ++ slotMessages
    74         timedMessages = Set.fromList $ "+LlRrUuDdZzAaSjJ,NpPwtgc12345" ++ slotMessages
    59 
       
    60 
    75 
    61 replayToDemo :: [TeamInfo]
    76 replayToDemo :: [TeamInfo]
    62         -> Map.Map B.ByteString B.ByteString
    77         -> Map.Map B.ByteString B.ByteString
    63         -> Map.Map B.ByteString [B.ByteString]
    78         -> Map.Map B.ByteString [B.ByteString]
    64         -> [B.ByteString]
    79         -> [B.ByteString]
   115 drawnMapData :: B.ByteString -> [B.ByteString]
   130 drawnMapData :: B.ByteString -> [B.ByteString]
   116 drawnMapData =
   131 drawnMapData =
   117           L.map (\m -> eml ["edraw ", BW.pack m])
   132           L.map (\m -> eml ["edraw ", BW.pack m])
   118         . L.unfoldr by200
   133         . L.unfoldr by200
   119         . BL.unpack
   134         . BL.unpack
   120         . Z.decompress
   135         . either (const BL.empty) id
       
   136         . decompressWithoutExceptions
   121         . BL.pack
   137         . BL.pack
   122         . L.drop 4
   138         . L.drop 4
   123         . fromMaybe []
   139         . fromMaybe []
   124         . Base64.decode
   140         . Base64.decode
   125         . B.unpack
   141         . B.unpack