author | unc0rr |
Thu, 01 May 2008 15:24:13 +0000 | |
changeset 896 | 93df8ac94382 |
parent 895 | 6aee2f335726 |
child 897 | 35d91fa3753b |
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 |
|
46 |
(client{room = newRoom, isMaster = True}, (RoomInfo newRoom roomPassword):rooms, [client], ["JOIN", newRoom, nick client]) |
|
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 |
59 |
(client{room = roomName}, rooms, client : fromRoom roomName clients, ["JOIN", roomName, nick client]) |
|
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:[]) = |
|
65 |
handleCmd_noRoom client clients rooms ["JOIN", roomName, ""] |
|
894 | 66 |
|
67 |
handleCmd_noRoom client _ rooms _ = (client, rooms, [client], ["ERROR", "Bad command or incorrect parameter"]) |
|
895 | 68 |
|
69 |
-- state-independent comman handlers |
|
70 |
handleCmd :: ClientInfo -> [ClientInfo] -> [RoomInfo] -> [String] -> (ClientInfo, [RoomInfo], [ClientInfo], [String]) |
|
893 | 71 |
|
72 |
handleCmd client clients rooms ("QUIT":xs) = |
|
891
701f86df9b4c
Properly handle QUIT command. Now, we can concentrate on protocol implementation
unc0rr
parents:
890
diff
changeset
|
73 |
if null (room client) then |
893 | 74 |
(client, rooms, [client], ["QUIT"]) |
891
701f86df9b4c
Properly handle QUIT command. Now, we can concentrate on protocol implementation
unc0rr
parents:
890
diff
changeset
|
75 |
else |
895 | 76 |
(client, rooms, fromRoom (room client) clients, ["QUIT", nick client]) |
893 | 77 |
|
895 | 78 |
-- check state and call state-dependent commmand handlers |
894 | 79 |
handleCmd client clients rooms cmd = |
80 |
if null (nick client) || protocol client == 0 then |
|
81 |
handleCmd_noInfo client clients rooms cmd |
|
893 | 82 |
else |
894 | 83 |
handleCmd_noRoom client clients rooms cmd |