|
1 {-# LANGUAGE OverloadedStrings #-} |
1 module HWProtoCore where |
2 module HWProtoCore where |
2 |
3 |
3 import qualified Data.IntMap as IntMap |
4 import Control.Monad.Reader |
4 import Data.Foldable |
|
5 import Data.Maybe |
5 import Data.Maybe |
|
6 import qualified Data.ByteString.Char8 as B |
6 -------------------------------------- |
7 -------------------------------------- |
7 import CoreTypes |
8 import CoreTypes |
8 import Actions |
9 import Actions |
9 import Utils |
|
10 import HWProtoNEState |
10 import HWProtoNEState |
11 import HWProtoLobbyState |
11 import HWProtoLobbyState |
12 import HWProtoInRoomState |
12 import HWProtoInRoomState |
|
13 import HandlerUtils |
|
14 import RoomsAndClients |
|
15 import Utils |
13 |
16 |
14 handleCmd, handleCmd_loggedin :: CmdHandler |
17 handleCmd, handleCmd_loggedin :: CmdHandler |
15 |
18 |
16 handleCmd clID _ _ ["PING"] = [AnswerThisClient ["PONG"]] |
|
17 |
19 |
18 handleCmd clID clients rooms ("QUIT" : xs) = |
20 handleCmd ["PING"] = answerClient ["PONG"] |
19 [ByeClient msg] |
|
20 where |
|
21 msg = if not $ null xs then head xs else "" |
|
22 |
21 |
23 |
22 |
24 handleCmd clID clients _ ["PONG"] = |
23 handleCmd ("QUIT" : xs) = return [ByeClient msg] |
25 if pingsQueue client == 0 then |
|
26 [ProtocolError "Protocol violation"] |
|
27 else |
|
28 [ModifyClient (\cl -> cl{pingsQueue = pingsQueue cl - 1})] |
|
29 where |
24 where |
30 client = clients IntMap.! clID |
25 msg = if not $ null xs then head xs else "bye" |
31 |
26 |
32 |
27 |
33 handleCmd clID clients rooms cmd = |
28 handleCmd ["PONG"] = do |
34 if not $ logonPassed client then |
29 cl <- thisClient |
35 handleCmd_NotEntered clID clients rooms cmd |
30 if pingsQueue cl == 0 then |
36 else |
31 return [ProtocolError "Protocol violation"] |
37 handleCmd_loggedin clID clients rooms cmd |
32 else |
38 where |
33 return [ModifyClient (\c -> c{pingsQueue = pingsQueue c - 1})] |
39 client = clients IntMap.! clID |
34 |
|
35 handleCmd cmd = do |
|
36 (ci, irnc) <- ask |
|
37 if logonPassed (irnc `client` ci) then |
|
38 handleCmd_loggedin cmd |
|
39 else |
|
40 handleCmd_NotEntered cmd |
40 |
41 |
41 |
42 |
42 handleCmd_loggedin clID clients rooms ["INFO", asknick] = |
43 handleCmd_loggedin ["INFO", asknick] = do |
|
44 (_, rnc) <- ask |
|
45 maybeClientId <- clientByNick asknick |
|
46 let noSuchClient = isNothing maybeClientId |
|
47 let clientId = fromJust maybeClientId |
|
48 let cl = rnc `client` fromJust maybeClientId |
|
49 let roomId = clientRoom rnc clientId |
|
50 let clRoom = room rnc roomId |
|
51 let roomMasterSign = if isMaster cl then "@" else "" |
|
52 let adminSign = if isAdministrator cl then "@" else "" |
|
53 let roomInfo = if roomId /= lobbyId then roomMasterSign `B.append` "room " `B.append` (name clRoom) else adminSign `B.append` "lobby" |
|
54 let roomStatus = if gameinprogress clRoom then |
|
55 if teamsInGame cl > 0 then "(playing)" else "(spectating)" |
|
56 else |
|
57 "" |
43 if noSuchClient then |
58 if noSuchClient then |
44 [] |
59 return [] |
45 else |
60 else |
46 [AnswerThisClient |
61 answerClient [ |
47 ["INFO", |
62 "INFO", |
48 nick client, |
63 nick cl, |
49 "[" ++ host client ++ "]", |
64 "[" `B.append` host cl `B.append` "]", |
50 protoNumber2ver $ clientProto client, |
65 protoNumber2ver $ clientProto cl, |
51 "[" ++ roomInfo ++ "]" ++ roomStatus]] |
66 "[" `B.append` roomInfo `B.append` "]" `B.append` roomStatus |
52 where |
67 ] |
53 maybeClient = find (\cl -> asknick == nick cl) clients |
|
54 noSuchClient = isNothing maybeClient |
|
55 client = fromJust maybeClient |
|
56 room = rooms IntMap.! roomID client |
|
57 roomInfo = if roomID client /= 0 then roomMasterSign ++ "room " ++ (name room) else adminSign ++ "lobby" |
|
58 roomMasterSign = if isMaster client then "@" else "" |
|
59 adminSign = if isAdministrator client then "@" else "" |
|
60 roomStatus = |
|
61 if gameinprogress room |
|
62 then if teamsInGame client > 0 then "(playing)" else "(spectating)" |
|
63 else "" |
|
64 |
68 |
65 |
69 |
66 handleCmd_loggedin clID clients rooms cmd = |
70 handleCmd_loggedin cmd = do |
67 if roomID client == 0 then |
71 (ci, rnc) <- ask |
68 handleCmd_lobby clID clients rooms cmd |
72 if clientRoom rnc ci == lobbyId then |
69 else |
73 handleCmd_lobby cmd |
70 handleCmd_inRoom clID clients rooms cmd |
74 else |
71 where |
75 handleCmd_inRoom cmd |
72 client = clients IntMap.! clID |
|