netserver/HWProto.hs
changeset 1308 d5dcd6cfa5e2
parent 1307 ce26e16d18ab
child 1309 1a38a967bd48
equal deleted inserted replaced
1307:ce26e16d18ab 1308:d5dcd6cfa5e2
     7 import Maybe (fromMaybe, fromJust)
     7 import Maybe (fromMaybe, fromJust)
     8 
     8 
     9 answerBadCmd = [(clientOnly, ["ERROR", "Bad command, state or incorrect parameter"])]
     9 answerBadCmd = [(clientOnly, ["ERROR", "Bad command, state or incorrect parameter"])]
    10 answerQuit = [(clientOnly, ["BYE"])]
    10 answerQuit = [(clientOnly, ["BYE"])]
    11 answerAbandoned = [(sameRoom, ["BYE"])]
    11 answerAbandoned = [(sameRoom, ["BYE"])]
    12 answerQuitInform nick = [(sameRoom, ["QUIT", nick])]
    12 answerQuitInform nick = [(othersInRoom, ["QUIT", nick])]
    13 answerNickChosen = [(clientOnly, ["ERROR", "The nick already chosen"])]
    13 answerNickChosen = [(clientOnly, ["ERROR", "The nick already chosen"])]
    14 answerNickChooseAnother = [(clientOnly, ["WARNING", "Choose another nick"])]
    14 answerNickChooseAnother = [(clientOnly, ["WARNING", "Choose another nick"])]
    15 answerNick nick = [(clientOnly, ["NICK", nick])]
    15 answerNick nick = [(clientOnly, ["NICK", nick])]
    16 answerProtocolKnown = [(clientOnly, ["ERROR", "Protocol number already known"])]
    16 answerProtocolKnown = [(clientOnly, ["ERROR", "Protocol number already known"])]
    17 answerBadInput = [(clientOnly, ["ERROR", "Bad input"])]
    17 answerBadInput = [(clientOnly, ["ERROR", "Bad input"])]
    28 handleCmd :: CmdHandler
    28 handleCmd :: CmdHandler
    29 handleCmd client _ rooms ("QUIT":xs) =
    29 handleCmd client _ rooms ("QUIT":xs) =
    30 	if null (room client) then
    30 	if null (room client) then
    31 		(noChangeClients, noChangeRooms, answerQuit)
    31 		(noChangeClients, noChangeRooms, answerQuit)
    32 	else if isMaster client then
    32 	else if isMaster client then
    33 		(noChangeClients, removeRoom (room client), answerAbandoned ++ (answerQuitInform $ nick client)) -- core disconnects clients on ROOMABANDONED answer
    33 		(noChangeClients, removeRoom (room client), answerAbandoned) -- core disconnects clients on ROOMABANDONED answer
    34 	else
    34 	else
    35 		(noChangeClients, noChangeRooms, answerQuitInform $ nick client)
    35 		(noChangeClients, noChangeRooms, answerQuitInform $ nick client)
    36 
    36 
    37 
    37 
    38 -- check state and call state-dependent commmand handlers
    38 -- check state and call state-dependent commmand handlers
    84 		haveSameRoom = not . null $ filter (\room -> newRoom == name room) rooms
    84 		haveSameRoom = not . null $ filter (\room -> newRoom == name room) rooms
    85 
    85 
    86 handleCmd_noRoom client clients rooms ["CREATE", newRoom] =
    86 handleCmd_noRoom client clients rooms ["CREATE", newRoom] =
    87 	handleCmd_noRoom client clients rooms ["CREATE", newRoom, ""]
    87 	handleCmd_noRoom client clients rooms ["CREATE", newRoom, ""]
    88 	
    88 	
    89 handleCmd_noRoom client _ rooms ["JOIN", roomName, roomPassword] =
    89 handleCmd_noRoom client clients rooms ["JOIN", roomName, roomPassword] =
    90 	if noSuchRoom then
    90 	if noSuchRoom then
    91 		(noChangeClients, noChangeRooms, answerNoRoom)
    91 		(noChangeClients, noChangeRooms, answerNoRoom)
    92 	else if roomPassword /= password (roomByName roomName rooms) then
    92 	else if roomPassword /= password (roomByName roomName rooms) then
    93 		(noChangeClients, noChangeRooms, answerWrongPassword)
    93 		(noChangeClients, noChangeRooms, answerWrongPassword)
    94 	else
    94 	else
    95 		(modifyClient client{room = roomName}, noChangeRooms, answerJoined $ nick client)
    95 		(modifyClient client{room = roomName}, noChangeRooms, (answerJoined $ nick client) ++ answerNicks)
    96 	where
    96 	where
    97 		noSuchRoom = null $ filter (\room -> roomName == name room) rooms
    97 		noSuchRoom = null $ filter (\room -> roomName == name room) rooms
       
    98 		answerNicks = [(clientOnly, ["JOINED"] ++ (map nick $ filter (\ci -> room ci == roomName) clients))]
    98 
    99 
    99 handleCmd_noRoom client clients rooms ["JOIN", roomName] =
   100 handleCmd_noRoom client clients rooms ["JOIN", roomName] =
   100 	handleCmd_noRoom client clients rooms ["JOIN", roomName, ""]
   101 	handleCmd_noRoom client clients rooms ["JOIN", roomName, ""]
   101 
   102 
   102 handleCmd_noRoom _ _ _ _ = (noChangeClients, noChangeRooms, answerBadCmd)
   103 handleCmd_noRoom _ _ _ _ = (noChangeClients, noChangeRooms, answerBadCmd)