4 import Data.List |
4 import Data.List |
5 import Data.Word |
5 import Data.Word |
6 import Miscutils |
6 import Miscutils |
7 import Maybe (fromMaybe, fromJust) |
7 import Maybe (fromMaybe, fromJust) |
8 |
8 |
|
9 answerBadCmd = [(clientOnly, ["ERROR", "Bad command, state or incorrect parameter"])] |
|
10 answerQuit = [(clientOnly, ["QUIT"])] |
|
11 answerAbandoned = [(sameRoom, ["ROOMABANDONED"])] |
|
12 answerQuitInform nick = [(sameRoom, ["QUIT", nick])] |
|
13 answerNickChosen = [(clientOnly, ["ERROR", "The nick already chosen"])] |
|
14 answerNickChooseAnother = [(clientOnly, ["WARNING", "Choose another nick"])] |
|
15 answerNick nick = [(clientOnly, ["NICK", nick])] |
|
16 answerProtocolKnown = [(clientOnly, ["ERROR", "Protocol number already known"])] |
|
17 answerBadInput = [(clientOnly, ["ERROR", "Bad input"])] |
|
18 answerProto protoNum = [(clientOnly, ["PROTO", show protoNum])] |
|
19 answerRoomsList list = [(clientOnly, ["ROOMS"] ++ list)] |
|
20 answerRoomExists = [(clientOnly, ["WARNING", "There's already a room with that name"])] |
|
21 answerJoined nick = [(sameRoom, ["JOINED", nick])] |
|
22 answerNoRoom = [(clientOnly, ["WARNING", "There's no room with that name"])] |
|
23 answerWrongPassword = [(clientOnly, ["WARNING", "Wrong password"])] |
|
24 answerChatString nick msg = [(othersInRoom, ["CHAT_STRING", nick, msg])] |
|
25 |
9 -- Main state-independent cmd handler |
26 -- Main state-independent cmd handler |
10 handleCmd :: CmdHandler |
27 handleCmd :: CmdHandler |
11 handleCmd client _ rooms ("QUIT":xs) = |
28 handleCmd client _ rooms ("QUIT":xs) = |
12 if null (room client) then |
29 if null (room client) then |
13 (noChangeClients, noChangeRooms, clientOnly, ["QUIT"]) |
30 (noChangeClients, noChangeRooms, answerQuit) |
14 else if isMaster client then |
31 else if isMaster client then |
15 (noChangeClients, removeRoom (room client), sameRoom, ["ROOMABANDONED"]) -- core disconnects clients on ROOMABANDONED command |
32 (noChangeClients, removeRoom (room client), (answerQuitInform $ nick client) ++ answerAbandoned) -- core disconnects clients on ROOMABANDONED answer |
16 else |
33 else |
17 (noChangeClients, noChangeRooms, sameRoom, ["QUIT", nick client]) |
34 (noChangeClients, noChangeRooms, answerQuitInform $ nick client) |
18 |
35 |
19 -- check state and call state-dependent commmand handlers |
36 -- check state and call state-dependent commmand handlers |
20 handleCmd client clients rooms cmd = |
37 handleCmd client clients rooms cmd = |
21 if null (nick client) || protocol client == 0 then |
38 if null (nick client) || protocol client == 0 then |
22 handleCmd_noInfo client clients rooms cmd |
39 handleCmd_noInfo client clients rooms cmd |
27 |
44 |
28 -- 'no info' state - need to get protocol number and nickname |
45 -- 'no info' state - need to get protocol number and nickname |
29 handleCmd_noInfo :: CmdHandler |
46 handleCmd_noInfo :: CmdHandler |
30 handleCmd_noInfo client clients _ ["NICK", newNick] = |
47 handleCmd_noInfo client clients _ ["NICK", newNick] = |
31 if not . null $ nick client then |
48 if not . null $ nick client then |
32 (noChangeClients, noChangeRooms, clientOnly, ["ERROR", "The nick already chosen"]) |
49 (noChangeClients, noChangeRooms, answerNickChosen) |
33 else if haveSameNick then |
50 else if haveSameNick then |
34 (noChangeClients, noChangeRooms, clientOnly, ["WARNING", "Choose another nick"]) |
51 (noChangeClients, noChangeRooms, answerNickChooseAnother) |
35 else |
52 else |
36 (modifyClient client{nick = newNick}, noChangeRooms, clientOnly, ["NICK", newNick]) |
53 (modifyClient client{nick = newNick}, noChangeRooms, answerNick newNick) |
37 where |
54 where |
38 haveSameNick = not . null $ filter (\cl -> newNick == nick cl) clients |
55 haveSameNick = not . null $ filter (\cl -> newNick == nick cl) clients |
39 |
56 |
40 handleCmd_noInfo client _ _ ["PROTO", protoNum] = |
57 handleCmd_noInfo client _ _ ["PROTO", protoNum] = |
41 if protocol client > 0 then |
58 if protocol client > 0 then |
42 (noChangeClients, noChangeRooms, clientOnly, ["ERROR", "Protocol number already known"]) |
59 (noChangeClients, noChangeRooms, answerProtocolKnown) |
43 else if parsedProto == 0 then |
60 else if parsedProto == 0 then |
44 (noChangeClients, noChangeRooms, clientOnly, ["ERROR", "Bad input"]) |
61 (noChangeClients, noChangeRooms, answerBadInput) |
45 else |
62 else |
46 (modifyClient client{protocol = parsedProto}, noChangeRooms, clientOnly, ["PROTO", show parsedProto]) |
63 (modifyClient client{protocol = parsedProto}, noChangeRooms, answerProto parsedProto) |
47 where |
64 where |
48 parsedProto = fromMaybe 0 (maybeRead protoNum :: Maybe Word16) |
65 parsedProto = fromMaybe 0 (maybeRead protoNum :: Maybe Word16) |
49 |
66 |
50 handleCmd_noInfo _ _ _ _ = (noChangeClients, noChangeRooms, clientOnly, badCmd) |
67 handleCmd_noInfo _ _ _ _ = (noChangeClients, noChangeRooms, answerBadCmd) |
51 |
68 |
52 -- 'noRoom' clients state command handlers |
69 -- 'noRoom' clients state command handlers |
53 handleCmd_noRoom :: CmdHandler |
70 handleCmd_noRoom :: CmdHandler |
54 handleCmd_noRoom client _ rooms ["LIST"] = |
71 handleCmd_noRoom client _ rooms ["LIST"] = |
55 (noChangeClients, noChangeRooms, clientOnly, ["ROOMS"] ++ map name rooms) |
72 (noChangeClients, noChangeRooms, answerRoomsList $ map name rooms) |
56 |
73 |
57 handleCmd_noRoom client _ rooms ["CREATE", newRoom, roomPassword] = |
74 handleCmd_noRoom client _ rooms ["CREATE", newRoom, roomPassword] = |
58 if haveSameRoom then |
75 if haveSameRoom then |
59 (noChangeClients, noChangeRooms, clientOnly, ["WARNING", "There's already a room with that name"]) |
76 (noChangeClients, noChangeRooms, answerRoomExists) |
60 else |
77 else |
61 (modifyClient client{room = newRoom, isMaster = True}, addRoom (RoomInfo newRoom roomPassword []), clientOnly, ["JOINED", nick client]) |
78 (modifyClient client{room = newRoom, isMaster = True}, addRoom (RoomInfo newRoom roomPassword []), answerJoined $ nick client) |
62 where |
79 where |
63 haveSameRoom = not . null $ filter (\room -> newRoom == name room) rooms |
80 haveSameRoom = not . null $ filter (\room -> newRoom == name room) rooms |
64 |
81 |
65 handleCmd_noRoom client clients rooms ["CREATE", newRoom] = |
82 handleCmd_noRoom client clients rooms ["CREATE", newRoom] = |
66 handleCmd_noRoom client clients rooms ["CREATE", newRoom, ""] |
83 handleCmd_noRoom client clients rooms ["CREATE", newRoom, ""] |
67 |
84 |
68 handleCmd_noRoom client _ rooms ["JOIN", roomName, roomPassword] = |
85 handleCmd_noRoom client _ rooms ["JOIN", roomName, roomPassword] = |
69 if noSuchRoom then |
86 if noSuchRoom then |
70 (noChangeClients, noChangeRooms, clientOnly, ["WARNING", "There's no room with that name"]) |
87 (noChangeClients, noChangeRooms, answerNoRoom) |
71 else if roomPassword /= password (roomByName roomName rooms) then |
88 else if roomPassword /= password (roomByName roomName rooms) then |
72 (noChangeClients, noChangeRooms, clientOnly, ["WARNING", "Wrong password"]) |
89 (noChangeClients, noChangeRooms, answerWrongPassword) |
73 else |
90 else |
74 (modifyClient client{room = roomName}, noChangeRooms, fromRoom roomName, ["JOINED", nick client]) |
91 (modifyClient client{room = roomName}, noChangeRooms, answerJoined $ nick client) |
75 where |
92 where |
76 noSuchRoom = null $ filter (\room -> roomName == name room) rooms |
93 noSuchRoom = null $ filter (\room -> roomName == name room) rooms |
77 |
94 |
78 handleCmd_noRoom client clients rooms ["JOIN", roomName] = |
95 handleCmd_noRoom client clients rooms ["JOIN", roomName] = |
79 handleCmd_noRoom client clients rooms ["JOIN", roomName, ""] |
96 handleCmd_noRoom client clients rooms ["JOIN", roomName, ""] |
80 |
97 |
81 handleCmd_noRoom _ _ _ _ = (noChangeClients, noChangeRooms, clientOnly, badCmd) |
98 handleCmd_noRoom _ _ _ _ = (noChangeClients, noChangeRooms, answerBadCmd) |
82 |
99 |
83 -- 'inRoom' clients state command handlers |
100 -- 'inRoom' clients state command handlers |
84 handleCmd_inRoom :: CmdHandler |
101 handleCmd_inRoom :: CmdHandler |
85 |
102 |
86 handleCmd_inRoom client _ _ ["CHAT_STRING", _, msg] = (noChangeClients, noChangeRooms, othersInRoom, ["CHAT_STRING", nick client, msg]) |
103 handleCmd_inRoom client _ _ ["CHAT_STRING", _, msg] = (noChangeClients, noChangeRooms, answerChatString (nick client) msg) |
87 |
104 |
88 handleCmd_inRoom client clients rooms ["CONFIG_PARAM", paramName, value] = |
105 handleCmd_inRoom _ _ _ _ = (noChangeClients, noChangeRooms, answerBadCmd) |
89 (noChangeClients, noChangeRooms, othersInRoom, ["CONFIG_PARAM", paramName, value]) |
|
90 |
|
91 handleCmd_inRoom client clients rooms ["CONFIG_PARAM", paramName, value1, value2] = |
|
92 (noChangeClients, noChangeRooms, othersInRoom, ["CONFIG_PARAM", paramName, value1, value2]) |
|
93 |
|
94 handleCmd_inRoom client clients rooms ("ADDTEAM:" : teamName : teamColor : graveName : fortName : teamLevel : hhs) = |
|
95 (noChangeClients, noChangeRooms, clientOnly, ["TEAM_ACCEPTED", teamName, "1"]) |
|
96 |
|
97 handleCmd_inRoom _ _ _ _ = (noChangeClients, noChangeRooms, clientOnly, badCmd) |
|