3 import IO |
3 import IO |
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 import qualified Data.Map as Map |
8 |
9 |
9 answerBadCmd = [(clientOnly, ["ERROR", "Bad command, state or incorrect parameter"])] |
10 answerBadCmd = [(clientOnly, ["ERROR", "Bad command, state or incorrect parameter"])] |
|
11 answerNotMaster = [(clientOnly, ["ERROR", "You cannot configure room parameters"])] |
10 answerQuit = [(clientOnly, ["off"])] |
12 answerQuit = [(clientOnly, ["off"])] |
11 answerAbandoned = [(sameRoom, ["BYE"])] |
13 answerAbandoned = [(sameRoom, ["BYE"])] |
12 answerQuitInform nick = [(othersInRoom, ["LEFT", nick])] |
14 answerQuitInform nick = [(othersInRoom, ["LEFT", nick])] |
13 answerNickChosen = [(clientOnly, ["ERROR", "The nick already chosen"])] |
15 answerNickChosen = [(clientOnly, ["ERROR", "The nick already chosen"])] |
14 answerNickChooseAnother = [(clientOnly, ["WARNING", "Choose another nick"])] |
16 answerNickChooseAnother = [(clientOnly, ["WARNING", "Choose another nick"])] |
20 answerRoomExists = [(clientOnly, ["WARNING", "There's already a room with that name"])] |
22 answerRoomExists = [(clientOnly, ["WARNING", "There's already a room with that name"])] |
21 answerJoined nick = [(sameRoom, ["JOINED", nick])] |
23 answerJoined nick = [(sameRoom, ["JOINED", nick])] |
22 answerNoRoom = [(clientOnly, ["WARNING", "There's no room with that name"])] |
24 answerNoRoom = [(clientOnly, ["WARNING", "There's no room with that name"])] |
23 answerWrongPassword = [(clientOnly, ["WARNING", "Wrong password"])] |
25 answerWrongPassword = [(clientOnly, ["WARNING", "Wrong password"])] |
24 answerChatString nick msg = [(othersInRoom, ["CHAT_STRING", nick, msg])] |
26 answerChatString nick msg = [(othersInRoom, ["CHAT_STRING", nick, msg])] |
25 |
27 answerConfigParam paramName paramStrs = [(othersInRoom, "CONFIG_PARAM" : paramName : paramStrs)] |
|
28 answerFullConfig room = map toAnswer (Map.toList $ params room) |
|
29 where |
|
30 toAnswer (paramName, paramStrs)= |
|
31 (clientOnly, "CONFIG_PARAM" : paramName : paramStrs) |
26 |
32 |
27 -- Main state-independent cmd handler |
33 -- Main state-independent cmd handler |
28 handleCmd :: CmdHandler |
34 handleCmd :: CmdHandler |
29 handleCmd client _ rooms ("QUIT":xs) = |
35 handleCmd client _ rooms ("QUIT":xs) = |
30 if null (room client) then |
36 if null (room client) then |
77 |
83 |
78 handleCmd_noRoom client _ rooms ["CREATE", newRoom, roomPassword] = |
84 handleCmd_noRoom client _ rooms ["CREATE", newRoom, roomPassword] = |
79 if haveSameRoom then |
85 if haveSameRoom then |
80 (noChangeClients, noChangeRooms, answerRoomExists) |
86 (noChangeClients, noChangeRooms, answerRoomExists) |
81 else |
87 else |
82 (modifyClient client{room = newRoom, isMaster = True}, addRoom (RoomInfo newRoom roomPassword []), answerJoined $ nick client) |
88 (modifyClient client{room = newRoom, isMaster = True}, addRoom (RoomInfo newRoom roomPassword (protocol client) [] Map.empty), answerJoined $ nick client) |
83 where |
89 where |
84 haveSameRoom = not . null $ filter (\room -> newRoom == name room) rooms |
90 haveSameRoom = not . null $ filter (\room -> newRoom == name room) rooms |
85 |
91 |
86 handleCmd_noRoom client clients rooms ["CREATE", newRoom] = |
92 handleCmd_noRoom client clients rooms ["CREATE", newRoom] = |
87 handleCmd_noRoom client clients rooms ["CREATE", newRoom, ""] |
93 handleCmd_noRoom client clients rooms ["CREATE", newRoom, ""] |
88 |
94 |
89 handleCmd_noRoom client clients rooms ["JOIN", roomName, roomPassword] = |
95 handleCmd_noRoom client clients rooms ["JOIN", roomName, roomPassword] = |
90 if noSuchRoom then |
96 if noSuchRoom then |
91 (noChangeClients, noChangeRooms, answerNoRoom) |
97 (noChangeClients, noChangeRooms, answerNoRoom) |
92 else if roomPassword /= password (roomByName roomName rooms) then |
98 else if roomPassword /= password joinRoom then |
93 (noChangeClients, noChangeRooms, answerWrongPassword) |
99 (noChangeClients, noChangeRooms, answerWrongPassword) |
94 else |
100 else |
95 (modifyClient client{room = roomName}, noChangeRooms, (answerJoined $ nick client) ++ answerNicks) |
101 (modifyClient client{room = roomName}, noChangeRooms, (answerJoined $ nick client) ++ answerNicks ++ answerFullConfig joinRoom) |
96 where |
102 where |
97 noSuchRoom = null $ filter (\room -> roomName == name room) rooms |
103 noSuchRoom = null $ filter (\room -> roomName == name room) rooms |
98 answerNicks = [(clientOnly, ["JOINED"] ++ (map nick $ filter (\ci -> room ci == roomName) clients))] |
104 answerNicks = [(clientOnly, ["JOINED"] ++ (map nick $ filter (\ci -> room ci == roomName) clients))] |
|
105 joinRoom = roomByName roomName rooms |
99 |
106 |
100 handleCmd_noRoom client clients rooms ["JOIN", roomName] = |
107 handleCmd_noRoom client clients rooms ["JOIN", roomName] = |
101 handleCmd_noRoom client clients rooms ["JOIN", roomName, ""] |
108 handleCmd_noRoom client clients rooms ["JOIN", roomName, ""] |
102 |
109 |
103 handleCmd_noRoom _ _ _ _ = (noChangeClients, noChangeRooms, answerBadCmd) |
110 handleCmd_noRoom _ _ _ _ = (noChangeClients, noChangeRooms, answerBadCmd) |
104 |
111 |
105 |
112 |
106 -- 'inRoom' clients state command handlers |
113 -- 'inRoom' clients state command handlers |
107 handleCmd_inRoom :: CmdHandler |
114 handleCmd_inRoom :: CmdHandler |
|
115 handleCmd_inRoom client _ _ ["CHAT_STRING", _, msg] = |
|
116 (noChangeClients, noChangeRooms, answerChatString (nick client) msg) |
108 |
117 |
109 handleCmd_inRoom client _ _ ["CHAT_STRING", _, msg] = (noChangeClients, noChangeRooms, answerChatString (nick client) msg) |
118 handleCmd_inRoom client _ _ ("CONFIG_PARAM":paramName:paramStrs) = |
|
119 if isMaster client then |
|
120 (noChangeClients, changeRoomConfig (room client) paramName paramStrs, answerConfigParam paramName paramStrs) |
|
121 else |
|
122 (noChangeClients, noChangeRooms, answerNotMaster) |
110 |
123 |
111 handleCmd_inRoom _ _ _ _ = (noChangeClients, noChangeRooms, answerBadCmd) |
124 handleCmd_inRoom _ _ _ _ = (noChangeClients, noChangeRooms, answerBadCmd) |