netserver/HWProto.hs
changeset 1082 596b1dcdc1df
parent 903 d4e5d8cbe449
child 1083 3448dd03483f
equal deleted inserted replaced
1081:5be338fa4e2c 1082:596b1dcdc1df
     4 import Data.List
     4 import Data.List
     5 import Data.Word
     5 import Data.Word
     6 import Miscutils
     6 import Miscutils
     7 import Maybe (fromMaybe, fromJust)
     7 import Maybe (fromMaybe, fromJust)
     8 
     8 
     9 -- 'noInfo' clients state command handlers
     9 -- Main state-independent cmd handler
    10 handleCmd_noInfo :: Handle -> [ClientInfo] -> [RoomInfo] -> [String] -> ([ClientInfo], [RoomInfo], [Handle], [String])
    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])
    11 
    18 
    12 handleCmd_noInfo clhandle clients rooms ("NICK":newNick:[]) =
    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] =
    13 	if not . null $ nick client then
    31 	if not . null $ nick client then
    14 		(clients, rooms, [clhandle], ["ERROR", "The nick already chosen"])
    32 		(noChangeClients, noChangeRooms, clientOnly, ["ERROR", "The nick already chosen"])
    15 	else if haveSameNick then
    33 	else if haveSameNick then
    16 		(clients, rooms, [clhandle], ["WARNING", "Choose another nick"])
    34 		(noChangeClients, noChangeRooms, clientOnly, ["WARNING", "Choose another nick"])
    17 	else
    35 	else
    18 		(modifyClient clhandle clients (\cl -> cl{nick = newNick}), rooms, [clhandle], ["NICK", newNick])
    36 		(modifyClient client{nick = newNick}, noChangeRooms, clientOnly, ["NICK", newNick])
    19 	where
    37 	where
    20 		haveSameNick = not . null $ filter (\cl -> newNick == nick cl) clients
    38 		haveSameNick = not . null $ filter (\cl -> newNick == nick cl) clients
    21 		client = clientByHandle clhandle clients
       
    22 
    39 
    23 handleCmd_noInfo clhandle clients rooms ("PROTO":protoNum:[]) =
    40 handleCmd_noInfo client _ _ ["PROTO", protoNum] =
    24 	if protocol client > 0 then
    41 	if protocol client > 0 then
    25 		(clients, rooms, [clhandle], ["ERROR", "Protocol number already known"])
    42 		(noChangeClients, noChangeRooms, clientOnly, ["ERROR", "Protocol number already known"])
    26 	else if parsedProto == 0 then
    43 	else if parsedProto == 0 then
    27 		(clients, rooms, [clhandle], ["ERROR", "Bad input"])
    44 		(noChangeClients, noChangeRooms, clientOnly, ["ERROR", "Bad input"])
    28 	else
    45 	else
    29 		(modifyClient clhandle clients (\cl -> cl{protocol = parsedProto}), rooms, [], [])
    46 		(modifyClient client{protocol = parsedProto}, noChangeRooms, clientOnly, ["PROTO", show parsedProto])
    30 	where
    47 	where
    31 		parsedProto = fromMaybe 0 (maybeRead protoNum :: Maybe Word16)
    48 		parsedProto = fromMaybe 0 (maybeRead protoNum :: Maybe Word16)
    32 		client = clientByHandle clhandle clients
       
    33 
    49 
    34 handleCmd_noInfo clhandle clients rooms _ = (clients, rooms, [clhandle], ["ERROR", "Bad command or incorrect parameter"])
    50 handleCmd_noInfo _ _ _ _ = (noChangeClients, noChangeRooms, clientOnly, badCmd)
    35 
       
    36 
    51 
    37 -- 'noRoom' clients state command handlers
    52 -- 'noRoom' clients state command handlers
    38 handleCmd_noRoom :: Handle -> [ClientInfo] -> [RoomInfo] -> [String] -> ([ClientInfo], [RoomInfo], [Handle], [String])
    53 handleCmd_noRoom :: CmdHandler
       
    54 handleCmd_noRoom client _ rooms ["LIST"] =
       
    55 		(noChangeClients, noChangeRooms, clientOnly, ["ROOMS"] ++ map name rooms)
    39 
    56 
    40 handleCmd_noRoom clhandle clients rooms ("LIST":[]) =
    57 handleCmd_noRoom client _ rooms ["CREATE", newRoom, roomPassword] =
    41 		(clients, rooms, [clhandle], ["ROOMS"] ++ map (\r -> name r) rooms)
       
    42 
       
    43 handleCmd_noRoom clhandle clients rooms ("CREATE":newRoom:roomPassword:[]) =
       
    44 	if haveSameRoom then
    58 	if haveSameRoom then
    45 		(clients, rooms, [clhandle], ["WARNING", "There's already a room with that name"])
    59 		(noChangeClients, noChangeRooms, clientOnly, ["WARNING", "There's already a room with that name"])
    46 	else
    60 	else
    47 		(modifyClient clhandle clients (\cl -> cl{room = newRoom, isMaster = True}), (RoomInfo newRoom roomPassword):rooms, [clhandle], ["JOINS", nick client])
    61 		(modifyClient client{room = newRoom, isMaster = True}, addRoom (RoomInfo newRoom roomPassword), clientOnly, ["JOINED", nick client])
    48 	where
    62 	where
    49 		haveSameRoom = not . null $ filter (\room -> newRoom == name room) rooms
    63 		haveSameRoom = not . null $ filter (\room -> newRoom == name room) rooms
    50 		client = clientByHandle clhandle clients
       
    51 
    64 
    52 handleCmd_noRoom clhandle clients rooms ("CREATE":newRoom:[]) =
    65 handleCmd_noRoom client clients rooms ["CREATE", newRoom] =
    53 	handleCmd_noRoom clhandle clients rooms ["CREATE", newRoom, ""]
    66 	handleCmd_noRoom client clients rooms ["CREATE", newRoom, ""]
    54 
    67 	
    55 handleCmd_noRoom clhandle clients rooms ("JOIN":roomName:roomPassword:[]) =
    68 handleCmd_noRoom client _ rooms ["JOIN", roomName, roomPassword] =
    56 	if noSuchRoom then
    69 	if noSuchRoom then
    57 		(clients, rooms, [clhandle], ["WARNING", "There's no room with that name"])
    70 		(noChangeClients, noChangeRooms, clientOnly, ["WARNING", "There's no room with that name"])
    58 	else if roomPassword /= password (roomByName roomName rooms) then
    71 	else if roomPassword /= password (roomByName roomName rooms) then
    59 		(clients, rooms, [clhandle], ["WARNING", "Wrong password"])
    72 		(noChangeClients, noChangeRooms, clientOnly, ["WARNING", "Wrong password"])
    60 	else
    73 	else
    61 		(modifyClient clhandle clients (\cl -> cl{room = roomName}), rooms, clhandle : (fromRoomHandles roomName clients), ["JOINS", nick client])
    74 		(modifyClient client{room = roomName}, noChangeRooms, fromRoom roomName, ["JOINED", nick client])
    62 	where
    75 	where
    63 		noSuchRoom = null $ filter (\room -> roomName == name room) rooms
    76 		noSuchRoom = null $ filter (\room -> roomName == name room) rooms
    64 		client = clientByHandle clhandle clients
       
    65 
    77 
    66 handleCmd_noRoom clhandle clients rooms ("JOIN":roomName:[]) =
    78 handleCmd_noRoom client clients rooms ["JOIN", roomName] =
    67 	handleCmd_noRoom clhandle clients rooms ["JOIN", roomName, ""]
    79 	handleCmd_noRoom client clients rooms ["JOIN", roomName, ""]
    68 
    80 
    69 handleCmd_noRoom clhandle clients rooms _ = (clients, rooms, [clhandle], ["ERROR", "Bad command or incorrect parameter"])
    81 handleCmd_noRoom _ _ _ _ = (noChangeClients, noChangeRooms, clientOnly, badCmd)
    70 
    82 
    71 -- 'inRoom' clients state command handlers
    83 -- 'inRoom' clients state command handlers
    72 handleCmd_inRoom :: Handle -> [ClientInfo] -> [RoomInfo] -> [String] -> ([ClientInfo], [RoomInfo], [Handle], [String])
    84 handleCmd_inRoom :: CmdHandler
    73 
    85 
    74 handleCmd_inRoom clhandle clients rooms _ = (clients, rooms, [clhandle], ["ERROR", "Bad command or incorrect parameter"])
    86 handleCmd_inRoom client _ _ ["CHAT_STRING", _, msg] = (noChangeClients, noChangeRooms, othersInRoom, ["CHAT_STRING", nick client, msg])
    75 
    87 
    76 -- state-independent command handlers
    88 handleCmd_inRoom client clients rooms ["CONFIG_PARAM", paramName, value] = (noChangeClients, noChangeRooms, othersInRoom, ["CONFIG_PARAM", paramName, value])
    77 handleCmd :: Handle -> [ClientInfo] -> [RoomInfo] -> [String] -> ([ClientInfo], [RoomInfo], [Handle], [String])
       
    78 
    89 
    79 handleCmd clhandle clients rooms ("QUIT":xs) =
    90 handleCmd_inRoom _ _ _ _ = (noChangeClients, noChangeRooms, clientOnly, badCmd)
    80 	if null (room client) then
       
    81 		(clients, rooms, [clhandle], ["QUIT"])
       
    82 	else if isMaster client then
       
    83 		(clients, filter (\rm -> room client /= name rm) rooms, roomMates, ["ROOMABANDONED"]) -- core disconnects clients on ROOMABANDONED command
       
    84 	else
       
    85 		(clients, rooms, roomMates, ["QUIT", nick client])
       
    86 	where
       
    87 		client = clientByHandle clhandle clients
       
    88 		roomMates = fromRoomHandles (room client) clients
       
    89 
       
    90 -- check state and call state-dependent commmand handlers
       
    91 handleCmd clhandle clients rooms cmd =
       
    92 	if null (nick client) || protocol client == 0 then
       
    93 		handleCmd_noInfo clhandle clients rooms cmd
       
    94 	else if null (room client) then
       
    95 		handleCmd_noRoom clhandle clients rooms cmd
       
    96 	else
       
    97 		handleCmd_inRoom clhandle clients rooms cmd
       
    98 	where
       
    99 		client = clientByHandle clhandle clients