4 import Control.Concurrent.STM |
4 import Control.Concurrent.STM |
5 import Data.Char |
5 import Data.Char |
6 import Data.Word |
6 import Data.Word |
7 import qualified Data.Map as Map |
7 import qualified Data.Map as Map |
8 import qualified Data.IntMap as IntMap |
8 import qualified Data.IntMap as IntMap |
|
9 import qualified Data.Set as Set |
9 import Numeric |
10 import Numeric |
10 import Network.Socket |
11 import Network.Socket |
11 import System.IO |
12 import System.IO |
12 import qualified Data.List as List |
13 import qualified Data.List as List |
|
14 import Maybe |
13 ------------------------------------------------- |
15 ------------------------------------------------- |
14 import qualified Codec.Binary.Base64 as Base64 |
16 import qualified Codec.Binary.Base64 as Base64 |
15 import qualified Codec.Binary.UTF8.String as UTF8 |
17 import qualified Codec.Binary.UTF8.String as UTF8 |
16 import CoreTypes |
18 import CoreTypes |
17 |
19 |
24 $ concatMap (\n -> (\(a, b) -> [showHex a, showHex b]) $ divMod n 65536) [a, b, c, d]) [] |
26 $ concatMap (\n -> (\(a, b) -> [showHex a, showHex b]) $ divMod n 65536) [a, b, c, d]) [] |
25 |
27 |
26 toEngineMsg :: String -> String |
28 toEngineMsg :: String -> String |
27 toEngineMsg msg = Base64.encode (fromIntegral (length msg) : (UTF8.encode msg)) |
29 toEngineMsg msg = Base64.encode (fromIntegral (length msg) : (UTF8.encode msg)) |
28 |
30 |
29 --tselect :: [ClientInfo] -> STM ([String], ClientInfo) |
31 fromEngineMsg :: String -> Maybe String |
30 --tselect = foldl orElse retry . map (\ci -> (flip (,) ci) `fmap` readTChan (chan ci)) |
32 fromEngineMsg msg = Base64.decode msg >>= return . UTF8.decode >>= removeLength |
|
33 where |
|
34 removeLength (x:xs) = if length xs == ord x then Just xs else Nothing |
|
35 removeLength _ = Nothing |
|
36 |
|
37 isLegalNetCommand :: String -> Bool |
|
38 isLegalNetCommand msg = test decoded |
|
39 where |
|
40 decoded = fromEngineMsg msg |
|
41 test Nothing = False |
|
42 test (Just "") = False |
|
43 test (Just (m:ms)) = m `Set.member` legalMessages |
|
44 legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sFNpPwtghb12345" ++ slotMessages |
|
45 slotMessages = ['\128', '\129', '\130', '\131', '\132', '\133', '\134', '\135', '\136', '\137', '\138'] |
31 |
46 |
32 maybeRead :: Read a => String -> Maybe a |
47 maybeRead :: Read a => String -> Maybe a |
33 maybeRead s = case reads s of |
48 maybeRead s = case reads s of |
34 [(x, rest)] | all isSpace rest -> Just x |
49 [(x, rest)] | all isSpace rest -> Just x |
35 _ -> Nothing |
50 _ -> Nothing |