author | smaxx |
Fri, 10 Sep 2010 16:42:11 +0200 | |
changeset 3847 | 771562124b16 |
parent 3671 | a94d1dc4a8d9 |
child 4242 | 5e3c5fe2cb14 |
permissions | -rw-r--r-- |
3500
af8390d807d6
Use sockets instead of handles, use bytestrings instead of strings
unc0rr
parents:
3458
diff
changeset
|
1 |
{-# LANGUAGE OverloadedStrings #-} |
1804 | 2 |
module HWProtoNEState where |
3 |
||
4 |
import qualified Data.IntMap as IntMap |
|
3671
a94d1dc4a8d9
- burp's patch cleaning up module dependancies + cabal file
unc0rr
parents:
3566
diff
changeset
|
5 |
import Data.Maybe |
1804 | 6 |
import Data.List |
7 |
import Data.Word |
|
3458 | 8 |
import Control.Monad.Reader |
3500
af8390d807d6
Use sockets instead of handles, use bytestrings instead of strings
unc0rr
parents:
3458
diff
changeset
|
9 |
import qualified Data.ByteString.Char8 as B |
1804 | 10 |
-------------------------------------- |
11 |
import CoreTypes |
|
12 |
import Actions |
|
13 |
import Utils |
|
3458 | 14 |
import RoomsAndClients |
1804 | 15 |
|
16 |
handleCmd_NotEntered :: CmdHandler |
|
17 |
||
3458 | 18 |
handleCmd_NotEntered ["NICK", newNick] = do |
19 |
(ci, irnc) <- ask |
|
20 |
let cl = irnc `client` ci |
|
3500
af8390d807d6
Use sockets instead of handles, use bytestrings instead of strings
unc0rr
parents:
3458
diff
changeset
|
21 |
if not . B.null $ nick cl then return [ProtocolError "Nickname already chosen"] |
3458 | 22 |
else |
3538 | 23 |
if haveSameNick irnc (nick cl) then return [AnswerClients [sendChan cl] ["WARNING", "Nickname already in use"], ByeClient ""] |
24 |
else |
|
3458 | 25 |
if illegalName newNick then return [ByeClient "Illegal nickname"] |
26 |
else |
|
27 |
return $ |
|
28 |
ModifyClient (\c -> c{nick = newNick}) : |
|
29 |
AnswerClients [sendChan cl] ["NICK", newNick] : |
|
30 |
[CheckRegistered | clientProto cl /= 0] |
|
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
31 |
where |
3538 | 32 |
haveSameNick irnc clNick = isJust $ find (\cl -> newNick == clNick) $ map (client irnc) $ allClients irnc |
3536 | 33 |
|
3458 | 34 |
handleCmd_NotEntered ["PROTO", protoNum] = do |
35 |
(ci, irnc) <- ask |
|
36 |
let cl = irnc `client` ci |
|
37 |
if clientProto cl > 0 then return [ProtocolError "Protocol already known"] |
|
3566 | 38 |
else |
3458 | 39 |
if parsedProto == 0 then return [ProtocolError "Bad number"] |
3566 | 40 |
else |
3458 | 41 |
return $ |
42 |
ModifyClient (\c -> c{clientProto = parsedProto}) : |
|
3500
af8390d807d6
Use sockets instead of handles, use bytestrings instead of strings
unc0rr
parents:
3458
diff
changeset
|
43 |
AnswerClients [sendChan cl] ["PROTO", B.pack $ show parsedProto] : |
af8390d807d6
Use sockets instead of handles, use bytestrings instead of strings
unc0rr
parents:
3458
diff
changeset
|
44 |
[CheckRegistered | not . B.null $ nick cl] |
2867
9be6693c78cb
- Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents:
2747
diff
changeset
|
45 |
where |
3500
af8390d807d6
Use sockets instead of handles, use bytestrings instead of strings
unc0rr
parents:
3458
diff
changeset
|
46 |
parsedProto = case B.readInt protoNum of |
af8390d807d6
Use sockets instead of handles, use bytestrings instead of strings
unc0rr
parents:
3458
diff
changeset
|
47 |
Just (i, t) | B.null t -> fromIntegral i |
af8390d807d6
Use sockets instead of handles, use bytestrings instead of strings
unc0rr
parents:
3458
diff
changeset
|
48 |
otherwise -> 0 |
1841
fba7210b438b
Retrieve client password from web database and ask for it
unc0rr
parents:
1834
diff
changeset
|
49 |
|
3536 | 50 |
|
51 |
handleCmd_NotEntered ["PASSWORD", passwd] = do |
|
52 |
(ci, irnc) <- ask |
|
53 |
let cl = irnc `client` ci |
|
1879 | 54 |
|
3536 | 55 |
if passwd == webPassword cl then |
56 |
return $ JoinLobby : [AnswerClients [sendChan cl] ["ADMIN_ACCESS"] | isAdministrator cl] |
|
57 |
else |
|
58 |
return [ByeClient "Authentication failed"] |
|
1804 | 59 |
|
3536 | 60 |
{- |
1804 | 61 |
|
2868 | 62 |
handleCmd_NotEntered clID clients _ ["DUMP"] = |
63 |
if isAdministrator (clients IntMap.! clID) then [Dump] else [] |
|
3435 | 64 |
-} |
1804 | 65 |
|
3435 | 66 |
handleCmd_NotEntered _ = return [ProtocolError "Incorrect command (state: not entered)"] |