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