2 module HWProtoCore where |
2 module HWProtoCore where |
3 |
3 |
4 import Control.Monad.Reader |
4 import Control.Monad.Reader |
5 import Data.Maybe |
5 import Data.Maybe |
6 import qualified Data.ByteString.Char8 as B |
6 import qualified Data.ByteString.Char8 as B |
7 import qualified Data.List as L |
|
8 -------------------------------------- |
7 -------------------------------------- |
9 import CoreTypes |
8 import CoreTypes |
10 import Actions |
9 import Actions |
11 import HWProtoNEState |
10 import HWProtoNEState |
12 import HWProtoLobbyState |
11 import HWProtoLobbyState |
32 if pingsQueue cl == 0 then |
31 if pingsQueue cl == 0 then |
33 return [ProtocolError "Protocol violation"] |
32 return [ProtocolError "Protocol violation"] |
34 else |
33 else |
35 return [ModifyClient (\c -> c{pingsQueue = pingsQueue c - 1})] |
34 return [ModifyClient (\c -> c{pingsQueue = pingsQueue c - 1})] |
36 |
35 |
37 handleCmd ("CMD" : parameters) = |
36 handleCmd ["CMD", parameters] = do |
38 let c = concatMap B.words parameters in |
37 let (cmd, plist) = B.break (== ' ') parameters |
39 if not $ null c then |
38 let param = B.dropWhile (== ' ') plist |
40 h $ (upperCase . head $ c) : tail c |
39 h (upperCase cmd) param |
41 else |
|
42 return [] |
|
43 where |
40 where |
44 h ["DELEGATE", n] = handleCmd ["DELEGATE", n] |
41 h "DELEGATE" n | not $ B.null n = handleCmd ["DELEGATE", n] |
45 h ["STATS"] = handleCmd ["STATS"] |
42 h "STATS" _ = handleCmd ["STATS"] |
46 h ("PART":m:ms) = handleCmd ["PART", B.unwords $ m:ms] |
43 h "PART" m | not $ B.null m = handleCmd ["PART", m] |
47 h ("QUIT":m:ms) = handleCmd ["QUIT", B.unwords $ m:ms] |
44 | otherwise = handleCmd ["PART"] |
48 h ("RND":rs) = handleCmd ("RND":rs) |
45 h "QUIT" m | not $ B.null m = handleCmd ["QUIT", m] |
49 h ("GLOBAL":m:ms) = do |
46 | otherwise = handleCmd ["QUIT"] |
|
47 h "RND" p = handleCmd ("RND" : B.words p) |
|
48 h "GLOBAL" p = do |
50 cl <- thisClient |
49 cl <- thisClient |
51 rnc <- liftM snd ask |
50 rnc <- liftM snd ask |
52 let chans = map (sendChan . client rnc) $ allClients rnc |
51 let chans = map (sendChan . client rnc) $ allClients rnc |
53 return [AnswerClients chans ["CHAT", "[global notice]", B.unwords $ m:ms] | isAdministrator cl] |
52 return [AnswerClients chans ["CHAT", "[global notice]", p] | isAdministrator cl] |
54 h c = return [Warning . B.concat . L.intersperse " " $ "Unknown cmd" : c] |
53 h c p = return [Warning $ B.concat ["Unknown cmd: /", c, p]] |
55 |
54 |
56 handleCmd cmd = do |
55 handleCmd cmd = do |
57 (ci, irnc) <- ask |
56 (ci, irnc) <- ask |
58 let cl = irnc `client` ci |
57 let cl = irnc `client` ci |
59 if logonPassed cl then |
58 if logonPassed cl then |