author | sheepluva |
Thu, 12 Jun 2014 15:17:53 +0200 | |
changeset 10286 | 1940e937fc08 |
parent 10212 | 5fb3bb2de9d2 |
child 10460 | 8dcea9087d75 |
permissions | -rw-r--r-- |
3435 | 1 |
module HandlerUtils where |
2 |
||
3 |
import Control.Monad.Reader |
|
3500
af8390d807d6
Use sockets instead of handles, use bytestrings instead of strings
unc0rr
parents:
3435
diff
changeset
|
4 |
import qualified Data.ByteString.Char8 as B |
4614 | 5 |
import Data.List |
3435 | 6 |
|
7 |
import RoomsAndClients |
|
8 |
import CoreTypes |
|
9109
878f06e9c484
- Fix issue 521 by resending FULLMAPCONFIG on game finish to those who joined mid-game. Semitested.
unc0rr
parents:
6541
diff
changeset
|
9 |
|
3435 | 10 |
|
10212 | 11 |
type CmdHandler = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action] |
12 |
||
3435 | 13 |
thisClient :: Reader (ClientIndex, IRnC) ClientInfo |
14 |
thisClient = do |
|
15 |
(ci, rnc) <- ask |
|
16 |
return $ rnc `client` ci |
|
17 |
||
3568 | 18 |
thisRoom :: Reader (ClientIndex, IRnC) RoomInfo |
19 |
thisRoom = do |
|
20 |
(ci, rnc) <- ask |
|
21 |
let ri = clientRoom rnc ci |
|
22 |
return $ rnc `room` ri |
|
23 |
||
3500
af8390d807d6
Use sockets instead of handles, use bytestrings instead of strings
unc0rr
parents:
3435
diff
changeset
|
24 |
clientNick :: Reader (ClientIndex, IRnC) B.ByteString |
3435 | 25 |
clientNick = liftM nick thisClient |
26 |
||
27 |
roomOthersChans :: Reader (ClientIndex, IRnC) [ClientChan] |
|
28 |
roomOthersChans = do |
|
29 |
(ci, rnc) <- ask |
|
30 |
let ri = clientRoom rnc ci |
|
3542 | 31 |
return $ map (sendChan . client rnc) $ filter (/= ci) (roomClients rnc ri) |
3435 | 32 |
|
4614 | 33 |
roomSameClanChans :: Reader (ClientIndex, IRnC) [ClientChan] |
34 |
roomSameClanChans = do |
|
35 |
(ci, rnc) <- ask |
|
36 |
let ri = clientRoom rnc ci |
|
37 |
let otherRoomClients = map (client rnc) . filter (/= ci) $ roomClients rnc ri |
|
38 |
let cl = rnc `client` ci |
|
4986
33fe91b2bcbf
Use Maybe for storing client's clan, allows less error-prone spectator checks
unc0rr
parents:
4975
diff
changeset
|
39 |
let sameClanClients = Prelude.filter (\c -> clientClan c == clientClan cl) otherRoomClients |
33fe91b2bcbf
Use Maybe for storing client's clan, allows less error-prone spectator checks
unc0rr
parents:
4975
diff
changeset
|
40 |
return $ map sendChan sameClanClients |
4614 | 41 |
|
3543 | 42 |
roomClientsChans :: Reader (ClientIndex, IRnC) [ClientChan] |
43 |
roomClientsChans = do |
|
44 |
(ci, rnc) <- ask |
|
45 |
let ri = clientRoom rnc ci |
|
46 |
return $ map (sendChan . client rnc) (roomClients rnc ri) |
|
47 |
||
3435 | 48 |
thisClientChans :: Reader (ClientIndex, IRnC) [ClientChan] |
49 |
thisClientChans = do |
|
50 |
(ci, rnc) <- ask |
|
4932 | 51 |
return [sendChan (rnc `client` ci)] |
3435 | 52 |
|
6541
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
4989
diff
changeset
|
53 |
sameProtoChans :: Reader (ClientIndex, IRnC) [ClientChan] |
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
4989
diff
changeset
|
54 |
sameProtoChans = do |
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
4989
diff
changeset
|
55 |
(ci, rnc) <- ask |
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
4989
diff
changeset
|
56 |
let p = clientProto (rnc `client` ci) |
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
4989
diff
changeset
|
57 |
return . map sendChan . filter (\c -> clientProto c == p) . map (client rnc) $ allClients rnc |
08ed346ed341
Send full room info on room add and update events. Less(?) traffic, but current frontend doesn't behave good with this change to server.
unc0rr
parents:
4989
diff
changeset
|
58 |
|
4989 | 59 |
answerClient :: [B.ByteString] -> Reader (ClientIndex, IRnC) [Action] |
4932 | 60 |
answerClient msg = liftM ((: []) . flip AnswerClients msg) thisClientChans |
3501 | 61 |
|
62 |
allRoomInfos :: Reader (a, IRnC) [RoomInfo] |
|
63 |
allRoomInfos = liftM ((\irnc -> map (room irnc) $ allRooms irnc) . snd) ask |
|
4614 | 64 |
|
65 |
clientByNick :: B.ByteString -> Reader (ClientIndex, IRnC) (Maybe ClientIndex) |
|
66 |
clientByNick n = do |
|
67 |
(_, rnc) <- ask |
|
68 |
let allClientIDs = allClients rnc |
|
9433 | 69 |
return $ find (\clId -> let cl = client rnc clId in n == nick cl && not (isChecker cl)) allClientIDs |
4614 | 70 |
|
10194 | 71 |
|
72 |
roomAdminOnly :: Reader (ClientIndex, IRnC) [Action] -> Reader (ClientIndex, IRnC) [Action] |
|
73 |
roomAdminOnly h = thisClient >>= \cl -> if isMaster cl then h else return [] |
|
74 |
||
75 |
||
76 |
serverAdminOnly :: Reader (ClientIndex, IRnC) [Action] -> Reader (ClientIndex, IRnC) [Action] |
|
77 |
serverAdminOnly h = thisClient >>= \cl -> if isAdministrator cl then h else return [] |