author  unc0rr 
Sat, 29 Jan 2011 21:33:24 +0300  
branch  server_refactor 
changeset 4612  e82758d6f924 
parent 4337  85e02b1a8e8f 
child 4614  26661bf28dd5 
permissions  rwrr 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

1 
{# LANGUAGE OverloadedStrings #} 
1804  2 
module HWProtoCore where 
3 

4612  4 
import Control.Monad.Reader 
4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

5 
import Data.Maybe 
4612  6 
import Data.List 
7 
import qualified Data.ByteString.Char8 as B 

1804  8 
 
9 
import CoreTypes 

10 
import Actions 

11 
import HWProtoNEState 

12 
import HWProtoLobbyState 

13 
import HWProtoInRoomState 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

14 
import HandlerUtils 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

15 
import RoomsAndClients 
4612  16 
import Utils 
1804  17 

1862  18 
handleCmd, handleCmd_loggedin :: CmdHandler 
1804  19 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

20 

1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

21 
handleCmd ["PING"] = answerClient ["PONG"] 
1804  22 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

23 

1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

24 
handleCmd ("QUIT" : xs) = return [ByeClient msg] 
2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2706
diff
changeset

25 
where 
4612  26 
msg = if not $ null xs then head xs else "bye" 
27 

1804  28 

4612  29 
handleCmd ["PONG"] = do 
30 
cl < thisClient 

31 
if pingsQueue cl == 0 then 

32 
return [ProtocolError "Protocol violation"] 

33 
else 

34 
return [ModifyClient (\c > c{pingsQueue = pingsQueue c  1})] 

1928  35 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

36 
handleCmd cmd = do 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

37 
(ci, irnc) < ask 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

38 
if logonPassed (irnc `client` ci) then 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

39 
handleCmd_loggedin cmd 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

40 
else 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

41 
handleCmd_NotEntered cmd 
1862  42 

4612  43 

44 
handleCmd_loggedin ["INFO", asknick] = do 

45 
(_, rnc) < ask 

46 
let allClientIDs = allClients rnc 

47 
let maybeClientId = find (\clId > asknick == nick (client rnc clId)) allClientIDs 

48 
let noSuchClient = isNothing maybeClientId 

49 
let clientId = fromJust maybeClientId 

50 
let cl = rnc `client` fromJust maybeClientId 

51 
let roomId = clientRoom rnc clientId 

52 
let clRoom = room rnc roomId 

53 
let roomMasterSign = if isMaster cl then "@" else "" 

54 
let adminSign = if isAdministrator cl then "@" else "" 

55 
let roomInfo = if roomId /= lobbyId then roomMasterSign `B.append` "room " `B.append` (name clRoom) else adminSign `B.append` "lobby" 

56 
let roomStatus = if gameinprogress clRoom then 

57 
if teamsInGame cl > 0 then "(playing)" else "(spectating)" 

58 
else 

59 
"" 

2867
9be6693c78cb
 Unbreak support for client versions prior to 0.9.13dev
unc0rr
parents:
2706
diff
changeset

60 
if noSuchClient then 
4612  61 
return [] 
62 
else 

63 
answerClient [ 

64 
"INFO", 

65 
nick cl, 

66 
"[" `B.append` host cl `B.append` "]", 

67 
protoNumber2ver $ clientProto cl, 

68 
"[" `B.append` roomInfo `B.append` "]" `B.append` roomStatus 

69 
] 

1862  70 

4295
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

71 

1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

72 
handleCmd_loggedin cmd = do 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

73 
(ci, rnc) < ask 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

74 
if clientRoom rnc ci == lobbyId then 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

75 
handleCmd_lobby cmd 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

76 
else 
1f5604cd99be
This revision should, in theory, correctly merge 0.9.14 and tip, so that future merges of 0.9.14 should work properly
nemo
parents:
4242
diff
changeset

77 
handleCmd_inRoom cmd 