author  unc0rr 
Sat, 19 Jan 2013 00:51:28 +0400  
changeset 8401  87410ae372f6 
parent 8372  3c193ec03e09 
child 10076  b235e520ea21 
permissions  rwrr 
8372
3c193ec03e09
Logon procedure for checkers, introduce invisible clients
unc0rr
parents:
8371
diff
changeset

1 
{# LANGUAGE OverloadedStrings, CPP #} 
1804  2 
module HWProtoNEState where 
3 

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

4 
import Control.Monad.Reader 
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 qualified Data.ByteString.Char8 as B 
1804  6 
 
7 
import CoreTypes 

8 
import Actions 

9 
import Utils 

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

10 
import RoomsAndClients 
1804  11 

4989  12 
handleCmd_NotEntered :: CmdHandler 
1804  13 

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 
handleCmd_NotEntered ["NICK", newNick] = 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

15 
(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

16 
let cl = irnc `client` ci 
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8372
diff
changeset

17 
if not . B.null $ nick cl then return [ProtocolError $ loc "Nickname already chosen"] 
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

18 
else 
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8372
diff
changeset

19 
if illegalName newNick then return [ByeClient $ loc "Illegal nickname"] 
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 
else 
4991  21 
return $ 
22 
ModifyClient (\c > c{nick = newNick}) : 

23 
AnswerClients [sendChan cl] ["NICK", newNick] : 

24 
[CheckRegistered  clientProto cl /= 0] 

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

25 

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

26 
handleCmd_NotEntered ["PROTO", protoNum] = 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

27 
(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

28 
let cl = irnc `client` ci 
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8372
diff
changeset

29 
if clientProto cl > 0 then return [ProtocolError $ loc "Protocol already known"] 
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

30 
else 
8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8372
diff
changeset

31 
if parsedProto == 0 then return [ProtocolError $ loc "Bad number"] 
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

32 
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

33 
return $ 
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

34 
ModifyClient (\c > c{clientProto = parsedProto}) : 
5030
42746c5d4a80
Changed the standard show function to Text.Show.ByteString, and misc.
EJ <eivind.jahren@gmail.com>
parents:
4991
diff
changeset

35 
AnswerClients [sendChan cl] ["PROTO", showB parsedProto] : 
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 
[CheckRegistered  not . B.null $ nick cl] 
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 
where 
5090  38 
parsedProto = readInt_ protoNum 
1841
fba7210b438b
Retrieve client password from web database and ask for it
unc0rr
parents:
1834
diff
changeset

39 

3536  40 

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

41 
handleCmd_NotEntered ["PASSWORD", passwd] = 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

42 
(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

43 
let cl = irnc `client` ci 
1879  44 

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

45 
if passwd == webPassword cl 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

46 
return $ JoinLobby : [AnswerClients [sendChan cl] ["ADMIN_ACCESS"]  isAdministrator cl] 
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

47 
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

48 
return [ByeClient "Authentication failed"] 
1879  49 

1804  50 

8372
3c193ec03e09
Logon procedure for checkers, introduce invisible clients
unc0rr
parents:
8371
diff
changeset

51 
#if defined(OFFICIAL_SERVER) 
8371  52 
handleCmd_NotEntered ["CHECKER", protoNum, newNick, password] = do 
53 
(ci, irnc) < ask 

54 
let cl = irnc `client` ci 

55 

8401
87410ae372f6
Server messages localization using Qt's l10n subsystem:
unc0rr
parents:
8372
diff
changeset

56 
if parsedProto == 0 then return [ProtocolError $ loc "Bad number"] 
8371  57 
else 
58 
return $ [ 

59 
ModifyClient (\c > c{clientProto = parsedProto, nick = newNick, webPassword = password, isChecker = True}) 

60 
, CheckRegistered] 

61 
where 

62 
parsedProto = readInt_ protoNum 

8372
3c193ec03e09
Logon procedure for checkers, introduce invisible clients
unc0rr
parents:
8371
diff
changeset

63 
#endif 
8371  64 

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

65 
handleCmd_NotEntered _ = return [ProtocolError "Incorrect command (state: not entered)"] 