|
890
|
1 |
module HWProto where
|
|
|
2 |
|
|
|
3 |
import IO
|
|
896
|
4 |
import Data.List
|
|
894
|
5 |
import Data.Word
|
|
890
|
6 |
import Miscutils
|
|
896
|
7 |
import Maybe (fromMaybe, fromJust)
|
|
890
|
8 |
|
|
1082
|
9 |
-- Main state-independent cmd handler
|
|
|
10 |
handleCmd :: CmdHandler
|
|
|
11 |
handleCmd client _ rooms ("QUIT":xs) =
|
|
|
12 |
if null (room client) then
|
|
|
13 |
(noChangeClients, noChangeRooms, clientOnly, ["QUIT"])
|
|
|
14 |
else if isMaster client then
|
|
|
15 |
(noChangeClients, removeRoom (room client), sameRoom, ["ROOMABANDONED"]) -- core disconnects clients on ROOMABANDONED command
|
|
|
16 |
else
|
|
|
17 |
(noChangeClients, noChangeRooms, sameRoom, ["QUIT", nick client])
|
|
895
|
18 |
|
|
1082
|
19 |
-- check state and call state-dependent commmand handlers
|
|
|
20 |
handleCmd client clients rooms cmd =
|
|
|
21 |
if null (nick client) || protocol client == 0 then
|
|
|
22 |
handleCmd_noInfo client clients rooms cmd
|
|
|
23 |
else if null (room client) then
|
|
|
24 |
handleCmd_noRoom client clients rooms cmd
|
|
|
25 |
else
|
|
|
26 |
handleCmd_inRoom client clients rooms cmd
|
|
|
27 |
|
|
|
28 |
-- 'no info' state - need to get protocol number and nickname
|
|
|
29 |
handleCmd_noInfo :: CmdHandler
|
|
|
30 |
handleCmd_noInfo client clients _ ["NICK", newNick] =
|
|
894
|
31 |
if not . null $ nick client then
|
|
1082
|
32 |
(noChangeClients, noChangeRooms, clientOnly, ["ERROR", "The nick already chosen"])
|
|
894
|
33 |
else if haveSameNick then
|
|
1082
|
34 |
(noChangeClients, noChangeRooms, clientOnly, ["WARNING", "Choose another nick"])
|
|
894
|
35 |
else
|
|
1082
|
36 |
(modifyClient client{nick = newNick}, noChangeRooms, clientOnly, ["NICK", newNick])
|
|
894
|
37 |
where
|
|
|
38 |
haveSameNick = not . null $ filter (\cl -> newNick == nick cl) clients
|
|
|
39 |
|
|
1082
|
40 |
handleCmd_noInfo client _ _ ["PROTO", protoNum] =
|
|
894
|
41 |
if protocol client > 0 then
|
|
1082
|
42 |
(noChangeClients, noChangeRooms, clientOnly, ["ERROR", "Protocol number already known"])
|
|
894
|
43 |
else if parsedProto == 0 then
|
|
1082
|
44 |
(noChangeClients, noChangeRooms, clientOnly, ["ERROR", "Bad input"])
|
|
894
|
45 |
else
|
|
1082
|
46 |
(modifyClient client{protocol = parsedProto}, noChangeRooms, clientOnly, ["PROTO", show parsedProto])
|
|
894
|
47 |
where
|
|
|
48 |
parsedProto = fromMaybe 0 (maybeRead protoNum :: Maybe Word16)
|
|
|
49 |
|
|
1082
|
50 |
handleCmd_noInfo _ _ _ _ = (noChangeClients, noChangeRooms, clientOnly, badCmd)
|
|
894
|
51 |
|
|
|
52 |
-- 'noRoom' clients state command handlers
|
|
1082
|
53 |
handleCmd_noRoom :: CmdHandler
|
|
|
54 |
handleCmd_noRoom client _ rooms ["LIST"] =
|
|
|
55 |
(noChangeClients, noChangeRooms, clientOnly, ["ROOMS"] ++ map name rooms)
|
|
903
|
56 |
|
|
1082
|
57 |
handleCmd_noRoom client _ rooms ["CREATE", newRoom, roomPassword] =
|
|
895
|
58 |
if haveSameRoom then
|
|
1082
|
59 |
(noChangeClients, noChangeRooms, clientOnly, ["WARNING", "There's already a room with that name"])
|
|
895
|
60 |
else
|
|
1082
|
61 |
(modifyClient client{room = newRoom, isMaster = True}, addRoom (RoomInfo newRoom roomPassword), clientOnly, ["JOINED", nick client])
|
|
895
|
62 |
where
|
|
|
63 |
haveSameRoom = not . null $ filter (\room -> newRoom == name room) rooms
|
|
|
64 |
|
|
1082
|
65 |
handleCmd_noRoom client clients rooms ["CREATE", newRoom] =
|
|
|
66 |
handleCmd_noRoom client clients rooms ["CREATE", newRoom, ""]
|
|
|
67 |
|
|
|
68 |
handleCmd_noRoom client _ rooms ["JOIN", roomName, roomPassword] =
|
|
902
|
69 |
if noSuchRoom then
|
|
1082
|
70 |
(noChangeClients, noChangeRooms, clientOnly, ["WARNING", "There's no room with that name"])
|
|
902
|
71 |
else if roomPassword /= password (roomByName roomName rooms) then
|
|
1082
|
72 |
(noChangeClients, noChangeRooms, clientOnly, ["WARNING", "Wrong password"])
|
|
895
|
73 |
else
|
|
1082
|
74 |
(modifyClient client{room = roomName}, noChangeRooms, fromRoom roomName, ["JOINED", nick client])
|
|
895
|
75 |
where
|
|
902
|
76 |
noSuchRoom = null $ filter (\room -> roomName == name room) rooms
|
|
895
|
77 |
|
|
1082
|
78 |
handleCmd_noRoom client clients rooms ["JOIN", roomName] =
|
|
|
79 |
handleCmd_noRoom client clients rooms ["JOIN", roomName, ""]
|
|
894
|
80 |
|
|
1082
|
81 |
handleCmd_noRoom _ _ _ _ = (noChangeClients, noChangeRooms, clientOnly, badCmd)
|
|
895
|
82 |
|
|
897
|
83 |
-- 'inRoom' clients state command handlers
|
|
1082
|
84 |
handleCmd_inRoom :: CmdHandler
|
|
897
|
85 |
|
|
1082
|
86 |
handleCmd_inRoom client _ _ ["CHAT_STRING", _, msg] = (noChangeClients, noChangeRooms, othersInRoom, ["CHAT_STRING", nick client, msg])
|
|
893
|
87 |
|
|
1082
|
88 |
handleCmd_inRoom client clients rooms ["CONFIG_PARAM", paramName, value] = (noChangeClients, noChangeRooms, othersInRoom, ["CONFIG_PARAM", paramName, value])
|
|
893
|
89 |
|
|
1082
|
90 |
handleCmd_inRoom _ _ _ _ = (noChangeClients, noChangeRooms, clientOnly, badCmd)
|