author | unc0rr |
Wed, 08 Oct 2008 18:25:08 +0000 | |
changeset 1321 | d7dc4e86201e |
parent 1320 | bffc7262e25e |
child 1322 | c624b04699fb |
permissions | -rw-r--r-- |
890 | 1 |
module HWProto where |
2 |
||
3 |
import IO |
|
896 | 4 |
import Data.List |
894 | 5 |
import Data.Word |
890 | 6 |
import Miscutils |
1320 | 7 |
import Maybe |
1317 | 8 |
import qualified Data.Map as Map |
890 | 9 |
|
1304
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
10 |
answerBadCmd = [(clientOnly, ["ERROR", "Bad command, state or incorrect parameter"])] |
1317 | 11 |
answerNotMaster = [(clientOnly, ["ERROR", "You cannot configure room parameters"])] |
1309 | 12 |
answerQuit = [(clientOnly, ["off"])] |
1305 | 13 |
answerAbandoned = [(sameRoom, ["BYE"])] |
1309 | 14 |
answerQuitInform nick = [(othersInRoom, ["LEFT", nick])] |
1304
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
15 |
answerNickChosen = [(clientOnly, ["ERROR", "The nick already chosen"])] |
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
16 |
answerNickChooseAnother = [(clientOnly, ["WARNING", "Choose another nick"])] |
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
17 |
answerNick nick = [(clientOnly, ["NICK", nick])] |
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
18 |
answerProtocolKnown = [(clientOnly, ["ERROR", "Protocol number already known"])] |
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
19 |
answerBadInput = [(clientOnly, ["ERROR", "Bad input"])] |
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
20 |
answerProto protoNum = [(clientOnly, ["PROTO", show protoNum])] |
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
21 |
answerRoomsList list = [(clientOnly, ["ROOMS"] ++ list)] |
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
22 |
answerRoomExists = [(clientOnly, ["WARNING", "There's already a room with that name"])] |
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
23 |
answerJoined nick = [(sameRoom, ["JOINED", nick])] |
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
24 |
answerNoRoom = [(clientOnly, ["WARNING", "There's no room with that name"])] |
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
25 |
answerWrongPassword = [(clientOnly, ["WARNING", "Wrong password"])] |
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
26 |
answerChatString nick msg = [(othersInRoom, ["CHAT_STRING", nick, msg])] |
1317 | 27 |
answerConfigParam paramName paramStrs = [(othersInRoom, "CONFIG_PARAM" : paramName : paramStrs)] |
28 |
answerFullConfig room = map toAnswer (Map.toList $ params room) |
|
29 |
where |
|
1321 | 30 |
toAnswer (paramName, paramStrs) = |
1317 | 31 |
(clientOnly, "CONFIG_PARAM" : paramName : paramStrs) |
1307 | 32 |
|
1082 | 33 |
-- Main state-independent cmd handler |
34 |
handleCmd :: CmdHandler |
|
35 |
handleCmd client _ rooms ("QUIT":xs) = |
|
36 |
if null (room client) then |
|
1304
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
37 |
(noChangeClients, noChangeRooms, answerQuit) |
1082 | 38 |
else if isMaster client then |
1308
d5dcd6cfa5e2
Fix another server failure (when second client in room disconnects)
unc0rr
parents:
1307
diff
changeset
|
39 |
(noChangeClients, removeRoom (room client), answerAbandoned) -- core disconnects clients on ROOMABANDONED answer |
1082 | 40 |
else |
1309 | 41 |
(noChangeClients, noChangeRooms, answerQuit ++ (answerQuitInform $ nick client)) |
895 | 42 |
|
1307 | 43 |
|
1082 | 44 |
-- check state and call state-dependent commmand handlers |
45 |
handleCmd client clients rooms cmd = |
|
46 |
if null (nick client) || protocol client == 0 then |
|
47 |
handleCmd_noInfo client clients rooms cmd |
|
48 |
else if null (room client) then |
|
49 |
handleCmd_noRoom client clients rooms cmd |
|
50 |
else |
|
51 |
handleCmd_inRoom client clients rooms cmd |
|
52 |
||
1307 | 53 |
|
1082 | 54 |
-- 'no info' state - need to get protocol number and nickname |
55 |
handleCmd_noInfo :: CmdHandler |
|
56 |
handleCmd_noInfo client clients _ ["NICK", newNick] = |
|
894 | 57 |
if not . null $ nick client then |
1304
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
58 |
(noChangeClients, noChangeRooms, answerNickChosen) |
894 | 59 |
else if haveSameNick then |
1304
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
60 |
(noChangeClients, noChangeRooms, answerNickChooseAnother) |
894 | 61 |
else |
1304
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
62 |
(modifyClient client{nick = newNick}, noChangeRooms, answerNick newNick) |
894 | 63 |
where |
1320 | 64 |
haveSameNick = isJust $ find (\cl -> newNick == nick cl) clients |
894 | 65 |
|
1082 | 66 |
handleCmd_noInfo client _ _ ["PROTO", protoNum] = |
894 | 67 |
if protocol client > 0 then |
1304
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
68 |
(noChangeClients, noChangeRooms, answerProtocolKnown) |
894 | 69 |
else if parsedProto == 0 then |
1304
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
70 |
(noChangeClients, noChangeRooms, answerBadInput) |
894 | 71 |
else |
1304
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
72 |
(modifyClient client{protocol = parsedProto}, noChangeRooms, answerProto parsedProto) |
894 | 73 |
where |
74 |
parsedProto = fromMaybe 0 (maybeRead protoNum :: Maybe Word16) |
|
75 |
||
1304
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
76 |
handleCmd_noInfo _ _ _ _ = (noChangeClients, noChangeRooms, answerBadCmd) |
894 | 77 |
|
1307 | 78 |
|
894 | 79 |
-- 'noRoom' clients state command handlers |
1082 | 80 |
handleCmd_noRoom :: CmdHandler |
81 |
handleCmd_noRoom client _ rooms ["LIST"] = |
|
1304
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
82 |
(noChangeClients, noChangeRooms, answerRoomsList $ map name rooms) |
903 | 83 |
|
1082 | 84 |
handleCmd_noRoom client _ rooms ["CREATE", newRoom, roomPassword] = |
895 | 85 |
if haveSameRoom then |
1304
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
86 |
(noChangeClients, noChangeRooms, answerRoomExists) |
895 | 87 |
else |
1317 | 88 |
(modifyClient client{room = newRoom, isMaster = True}, addRoom (RoomInfo newRoom roomPassword (protocol client) [] Map.empty), answerJoined $ nick client) |
895 | 89 |
where |
1320 | 90 |
haveSameRoom = isJust $ find (\room -> newRoom == name room) rooms |
895 | 91 |
|
1082 | 92 |
handleCmd_noRoom client clients rooms ["CREATE", newRoom] = |
93 |
handleCmd_noRoom client clients rooms ["CREATE", newRoom, ""] |
|
94 |
||
1308
d5dcd6cfa5e2
Fix another server failure (when second client in room disconnects)
unc0rr
parents:
1307
diff
changeset
|
95 |
handleCmd_noRoom client clients rooms ["JOIN", roomName, roomPassword] = |
902 | 96 |
if noSuchRoom then |
1304
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
97 |
(noChangeClients, noChangeRooms, answerNoRoom) |
1321 | 98 |
else if roomPassword /= password clRoom then |
1304
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
99 |
(noChangeClients, noChangeRooms, answerWrongPassword) |
895 | 100 |
else |
1321 | 101 |
(modifyClient client{room = roomName}, noChangeRooms, (answerJoined $ nick client) ++ answerNicks ++ answerFullConfig clRoom) |
895 | 102 |
where |
1320 | 103 |
noSuchRoom = isNothing $ find (\room -> roomName == name room) rooms |
1308
d5dcd6cfa5e2
Fix another server failure (when second client in room disconnects)
unc0rr
parents:
1307
diff
changeset
|
104 |
answerNicks = [(clientOnly, ["JOINED"] ++ (map nick $ filter (\ci -> room ci == roomName) clients))] |
1321 | 105 |
clRoom = roomByName roomName rooms |
895 | 106 |
|
1082 | 107 |
handleCmd_noRoom client clients rooms ["JOIN", roomName] = |
108 |
handleCmd_noRoom client clients rooms ["JOIN", roomName, ""] |
|
894 | 109 |
|
1304
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
110 |
handleCmd_noRoom _ _ _ _ = (noChangeClients, noChangeRooms, answerBadCmd) |
895 | 111 |
|
1307 | 112 |
|
897 | 113 |
-- 'inRoom' clients state command handlers |
1082 | 114 |
handleCmd_inRoom :: CmdHandler |
1317 | 115 |
handleCmd_inRoom client _ _ ["CHAT_STRING", _, msg] = |
116 |
(noChangeClients, noChangeRooms, answerChatString (nick client) msg) |
|
897 | 117 |
|
1321 | 118 |
handleCmd_inRoom client _ rooms ("CONFIG_PARAM":paramName:paramStrs) = |
1317 | 119 |
if isMaster client then |
1321 | 120 |
(noChangeClients, modifyRoom clRoom{params = Map.insert paramName paramStrs (params room)}, answerConfigParam paramName paramStrs) |
1317 | 121 |
else |
122 |
(noChangeClients, noChangeRooms, answerNotMaster) |
|
1321 | 123 |
where |
124 |
clRoom = roomByName (room client) rooms |
|
125 |
||
126 |
||
127 |
handleCmd_inRoom client _ _ ("ADDTEAM" : name : color : grave : fort : difStr : hhsInfo) |
|
128 |
| length hhsInfo == 16 = (noChangeClients, noChangeRooms, answerBadCmd) |
|
1083 | 129 |
|
1304
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
130 |
handleCmd_inRoom _ _ _ _ = (noChangeClients, noChangeRooms, answerBadCmd) |