author | unc0rr |
Thu, 01 May 2008 16:00:23 +0000 | |
changeset 899 | 36f91881e83f |
parent 898 | 344ba7dba23d |
child 901 | 2f5ce9a584f9 |
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 |
896 | 7 |
import Maybe (fromMaybe, fromJust) |
890 | 8 |
|
895 | 9 |
fromRoom :: String -> [ClientInfo] -> [ClientInfo] |
10 |
fromRoom roomName clients = filter (\cl -> roomName == room cl) clients |
|
891
701f86df9b4c
Properly handle QUIT command. Now, we can concentrate on protocol implementation
unc0rr
parents:
890
diff
changeset
|
11 |
|
894 | 12 |
-- 'noInfo' clients state command handlers |
895 | 13 |
handleCmd_noInfo :: ClientInfo -> [ClientInfo] -> [RoomInfo] -> [String] -> (ClientInfo, [RoomInfo], [ClientInfo], [String]) |
14 |
||
894 | 15 |
handleCmd_noInfo client clients rooms ("NICK":newNick:[]) = |
16 |
if not . null $ nick client then |
|
17 |
(client, rooms, [client], ["ERROR", "The nick already chosen"]) |
|
18 |
else if haveSameNick then |
|
19 |
(client, rooms, [client], ["WARNING", "Choose another nick"]) |
|
20 |
else |
|
21 |
(client{nick = newNick}, rooms, [client], ["NICK", newNick]) |
|
22 |
where |
|
23 |
haveSameNick = not . null $ filter (\cl -> newNick == nick cl) clients |
|
24 |
||
25 |
handleCmd_noInfo client clients rooms ("PROTO":protoNum:[]) = |
|
26 |
if protocol client > 0 then |
|
27 |
(client, rooms, [client], ["ERROR", "Protocol number already known"]) |
|
28 |
else if parsedProto == 0 then |
|
29 |
(client, rooms, [client], ["ERROR", "Bad input"]) |
|
30 |
else |
|
31 |
(client{protocol = parsedProto}, rooms, [], []) |
|
32 |
where |
|
33 |
parsedProto = fromMaybe 0 (maybeRead protoNum :: Maybe Word16) |
|
34 |
||
35 |
||
36 |
handleCmd_noInfo client _ rooms _ = (client, rooms, [client], ["ERROR", "Bad command or incorrect parameter"]) |
|
37 |
||
38 |
||
39 |
-- 'noRoom' clients state command handlers |
|
895 | 40 |
handleCmd_noRoom :: ClientInfo -> [ClientInfo] -> [RoomInfo] -> [String] -> (ClientInfo, [RoomInfo], [ClientInfo], [String]) |
41 |
||
42 |
handleCmd_noRoom client clients rooms ("CREATE":newRoom:roomPassword:[]) = |
|
43 |
if haveSameRoom then |
|
44 |
(client, rooms, [client], ["WARNING", "There's already a room with that name"]) |
|
45 |
else |
|
899 | 46 |
(client{room = newRoom, isMaster = True}, (RoomInfo newRoom roomPassword):rooms, [client], ["JOINS", nick client]) |
895 | 47 |
where |
48 |
haveSameRoom = not . null $ filter (\room -> newRoom == name room) rooms |
|
49 |
||
50 |
handleCmd_noRoom client clients rooms ("CREATE":newRoom:[]) = |
|
51 |
handleCmd_noRoom client clients rooms ["CREATE", newRoom, ""] |
|
52 |
||
53 |
handleCmd_noRoom client clients rooms ("JOIN":roomName:roomPassword:[]) = |
|
54 |
if noRoom then |
|
55 |
(client, rooms, [client], ["WARNING", "There's no room with that name"]) |
|
896 | 56 |
else if roomPassword /= password (getRoom roomName) then |
57 |
(client, rooms, [client], ["WARNING", "Wrong password"]) |
|
895 | 58 |
else |
899 | 59 |
(client{room = roomName}, rooms, client : fromRoom roomName clients, ["JOINS", nick client]) |
895 | 60 |
where |
61 |
noRoom = null $ filter (\room -> roomName == name room) rooms |
|
896 | 62 |
getRoom roomName = fromJust $ find (\room -> roomName == name room) rooms |
895 | 63 |
|
64 |
handleCmd_noRoom client clients rooms ("JOIN":roomName:[]) = |
|
899 | 65 |
handleCmd_noRoom client clients rooms ["JOIN", ""] |
894 | 66 |
|
67 |
handleCmd_noRoom client _ rooms _ = (client, rooms, [client], ["ERROR", "Bad command or incorrect parameter"]) |
|
895 | 68 |
|
897 | 69 |
-- 'inRoom' clients state command handlers |
70 |
handleCmd_inRoom :: ClientInfo -> [ClientInfo] -> [RoomInfo] -> [String] -> (ClientInfo, [RoomInfo], [ClientInfo], [String]) |
|
71 |
||
72 |
handleCmd_inRoom client _ rooms _ = (client, rooms, [client], ["ERROR", "Bad command or incorrect parameter"]) |
|
73 |
||
898 | 74 |
-- state-independent command handlers |
895 | 75 |
handleCmd :: ClientInfo -> [ClientInfo] -> [RoomInfo] -> [String] -> (ClientInfo, [RoomInfo], [ClientInfo], [String]) |
893 | 76 |
|
77 |
handleCmd client clients rooms ("QUIT":xs) = |
|
891
701f86df9b4c
Properly handle QUIT command. Now, we can concentrate on protocol implementation
unc0rr
parents:
890
diff
changeset
|
78 |
if null (room client) then |
893 | 79 |
(client, rooms, [client], ["QUIT"]) |
898 | 80 |
else if isMaster client then |
899 | 81 |
(client, filter (\rm -> room client /= name rm) rooms, fromRoom (room client) clients, ["ROOMABANDONED"]) -- core disconnect clients on ROOMABANDONED command |
891
701f86df9b4c
Properly handle QUIT command. Now, we can concentrate on protocol implementation
unc0rr
parents:
890
diff
changeset
|
82 |
else |
895 | 83 |
(client, rooms, fromRoom (room client) clients, ["QUIT", nick client]) |
893 | 84 |
|
895 | 85 |
-- check state and call state-dependent commmand handlers |
894 | 86 |
handleCmd client clients rooms cmd = |
87 |
if null (nick client) || protocol client == 0 then |
|
88 |
handleCmd_noInfo client clients rooms cmd |
|
897 | 89 |
else if null (room client) then |
90 |
handleCmd_noRoom client clients rooms cmd |
|
893 | 91 |
else |
897 | 92 |
handleCmd_inRoom client clients rooms cmd |