| author | unc0rr |
| Sun, 04 May 2008 13:49:55 +0000 | |
| changeset 901 | 2f5ce9a584f9 |
| parent 899 | 36f91881e83f |
| child 902 | 3cc10f0aae37 |
| 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 |
|
|
901
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
899
diff
changeset
|
40 |
{--handleCmd_noRoom clhandle clients rooms ("CREATE":newRoom:roomPassword:[]) =
|
| 895 | 41 |
if haveSameRoom then |
|
901
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
899
diff
changeset
|
42 |
(client, rooms, [clhandle], ["WARNING", "There's already a room with that name"]) |
| 895 | 43 |
else |
| 899 | 44 |
(client{room = newRoom, isMaster = True}, (RoomInfo newRoom roomPassword):rooms, [client], ["JOINS", nick client])
|
| 895 | 45 |
where |
46 |
haveSameRoom = not . null $ filter (\room -> newRoom == name room) rooms |
|
47 |
||
|
901
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
899
diff
changeset
|
48 |
handleCmd_noRoom clhandle clients rooms ("CREATE":newRoom:[]) =
|
| 895 | 49 |
handleCmd_noRoom client clients rooms ["CREATE", newRoom, ""] |
50 |
||
|
901
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
899
diff
changeset
|
51 |
handleCmd_noRoom clhandle clients rooms ("JOIN":roomName:roomPassword:[]) =
|
| 895 | 52 |
if noRoom then |
|
901
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
899
diff
changeset
|
53 |
(client, rooms, [clhandle], ["WARNING", "There's no room with that name"]) |
| 896 | 54 |
else if roomPassword /= password (getRoom roomName) then |
|
901
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
899
diff
changeset
|
55 |
(client, rooms, [clhandle], ["WARNING", "Wrong password"]) |
| 895 | 56 |
else |
| 899 | 57 |
(client{room = roomName}, rooms, client : fromRoom roomName clients, ["JOINS", nick client])
|
| 895 | 58 |
where |
59 |
noRoom = null $ filter (\room -> roomName == name room) rooms |
|
| 896 | 60 |
getRoom roomName = fromJust $ find (\room -> roomName == name room) rooms |
| 895 | 61 |
|
|
901
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
899
diff
changeset
|
62 |
handleCmd_noRoom clhandle clients rooms ("JOIN":roomName:[]) =
|
|
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
899
diff
changeset
|
63 |
handleCmd_noRoom client clients rooms ["JOIN", ""]--} |
| 894 | 64 |
|
|
901
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
899
diff
changeset
|
65 |
handleCmd_noRoom clhandle clients rooms _ = (clients, rooms, [clhandle], ["ERROR", "Bad command or incorrect parameter"]) |
| 895 | 66 |
|
| 897 | 67 |
-- 'inRoom' clients state command handlers |
|
901
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
899
diff
changeset
|
68 |
handleCmd_inRoom :: Handle -> [ClientInfo] -> [RoomInfo] -> [String] -> ([ClientInfo], [RoomInfo], [Handle], [String]) |
| 897 | 69 |
|
|
901
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
899
diff
changeset
|
70 |
handleCmd_inRoom clhandle clients rooms _ = (clients, rooms, [clhandle], ["ERROR", "Bad command or incorrect parameter"]) |
| 897 | 71 |
|
| 898 | 72 |
-- state-independent command handlers |
|
901
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
899
diff
changeset
|
73 |
handleCmd :: Handle -> [ClientInfo] -> [RoomInfo] -> [String] -> ([ClientInfo], [RoomInfo], [Handle], [String]) |
| 893 | 74 |
|
|
901
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
899
diff
changeset
|
75 |
handleCmd clhandle clients rooms ("QUIT":xs) =
|
|
891
701f86df9b4c
Properly handle QUIT command. Now, we can concentrate on protocol implementation
unc0rr
parents:
890
diff
changeset
|
76 |
if null (room client) then |
|
901
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
899
diff
changeset
|
77 |
(clients, rooms, [clhandle], ["QUIT"]) |
| 898 | 78 |
else if isMaster client then |
|
901
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
899
diff
changeset
|
79 |
(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
|
80 |
else |
|
901
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
899
diff
changeset
|
81 |
(clients, rooms, roomMates, ["QUIT", nick client]) |
|
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
899
diff
changeset
|
82 |
where |
|
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
899
diff
changeset
|
83 |
client = clientByHandle clhandle clients |
|
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
899
diff
changeset
|
84 |
roomMates = fromRoomHandles (room client) clients |
| 893 | 85 |
|
| 895 | 86 |
-- check state and call state-dependent commmand handlers |
|
901
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
899
diff
changeset
|
87 |
handleCmd clhandle clients rooms cmd = |
| 894 | 88 |
if null (nick client) || protocol client == 0 then |
|
901
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
899
diff
changeset
|
89 |
handleCmd_noInfo clhandle clients rooms cmd |
| 897 | 90 |
else if null (room client) then |
|
901
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
899
diff
changeset
|
91 |
handleCmd_noRoom clhandle clients rooms cmd |
| 893 | 92 |
else |
|
901
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
899
diff
changeset
|
93 |
handleCmd_inRoom clhandle clients rooms cmd |
|
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
899
diff
changeset
|
94 |
where |
|
2f5ce9a584f9
Modify protocol implementation functions interface (convertation not yet finished)
unc0rr
parents:
899
diff
changeset
|
95 |
client = clientByHandle clhandle clients |