gameServer/ServerState.hs
author koda
Thu, 26 Dec 2013 16:50:02 +0100
branch0.9.19
changeset 9146 0aa5c1ce9e11
parent 8452 170afc3ac39f
child 9973 7589978c9912
permissions -rw-r--r--
close branch
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
3458
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
     1
module ServerState
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
     2
    (
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
     3
    module RoomsAndClients,
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
     4
    clientRoomA,
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
     5
    ServerState(..),
3501
a3159a410e5c Reimplement more core actions
unc0rr
parents: 3458
diff changeset
     6
    client's,
3502
ad38c653b7d9 Some more progress
unc0rr
parents: 3501
diff changeset
     7
    allClientsS,
8452
170afc3ac39f Also rooms per version stats
unc0rr
parents: 8371
diff changeset
     8
    allRoomsS,
4601
08ae94dd4c0d io = liftIO
unc0rr
parents: 3807
diff changeset
     9
    roomClientsS,
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
    10
    sameProtoClientsS,
4601
08ae94dd4c0d io = liftIO
unc0rr
parents: 3807
diff changeset
    11
    io
3458
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    12
    ) where
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    13
3741
73246d25dfe1 Add some more strictness, use unsafeThaw and unsafeFreeze functions which work at O(1)
unc0rr
parents: 3645
diff changeset
    14
import Control.Monad.State.Strict
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
    15
import Data.Set as Set(Set)
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
    16
import Data.Word
3458
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    17
----------------------
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    18
import RoomsAndClients
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    19
import CoreTypes
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    20
4989
4771fed9272e - Write server config into .ini file on change
unc0rr
parents: 4975
diff changeset
    21
data ServerState = ServerState {
3807
7e4f7ed41790 zero span is undefined, use -1 instead
unc0rr
parents: 3741
diff changeset
    22
        clientIndex :: !(Maybe ClientIndex),
4989
4771fed9272e - Write server config into .ini file on change
unc0rr
parents: 4975
diff changeset
    23
        serverInfo :: !ServerInfo,
3807
7e4f7ed41790 zero span is undefined, use -1 instead
unc0rr
parents: 3741
diff changeset
    24
        removedClients :: !(Set.Set ClientIndex),
7e4f7ed41790 zero span is undefined, use -1 instead
unc0rr
parents: 3741
diff changeset
    25
        roomsClients :: !MRnC
3458
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    26
    }
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    27
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    28
4989
4771fed9272e - Write server config into .ini file on change
unc0rr
parents: 4975
diff changeset
    29
clientRoomA :: StateT ServerState IO RoomIndex
3458
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    30
clientRoomA = do
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    31
    (Just ci) <- gets clientIndex
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    32
    rnc <- gets roomsClients
4622
8bdc879ee6b2 Implement room delegation when admin lefts it
unc0rr
parents: 4601
diff changeset
    33
    io $ clientRoomM rnc ci
3458
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    34
4989
4771fed9272e - Write server config into .ini file on change
unc0rr
parents: 4975
diff changeset
    35
client's :: (ClientInfo -> a) -> StateT ServerState IO a
3501
a3159a410e5c Reimplement more core actions
unc0rr
parents: 3458
diff changeset
    36
client's f = do
3458
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    37
    (Just ci) <- gets clientIndex
11cd56019f00 Make some more protocol commands work
unc0rr
parents:
diff changeset
    38
    rnc <- gets roomsClients
4622
8bdc879ee6b2 Implement room delegation when admin lefts it
unc0rr
parents: 4601
diff changeset
    39
    io $ client'sM rnc f ci
3645
c0b3f1bb9316 Reimplement REMOVE_TEAM
unc0rr
parents: 3566
diff changeset
    40
4989
4771fed9272e - Write server config into .ini file on change
unc0rr
parents: 4975
diff changeset
    41
allClientsS :: StateT ServerState IO [ClientInfo]
3502
ad38c653b7d9 Some more progress
unc0rr
parents: 3501
diff changeset
    42
allClientsS = gets roomsClients >>= liftIO . clientsM
ad38c653b7d9 Some more progress
unc0rr
parents: 3501
diff changeset
    43
8452
170afc3ac39f Also rooms per version stats
unc0rr
parents: 8371
diff changeset
    44
allRoomsS :: StateT ServerState IO [RoomInfo]
170afc3ac39f Also rooms per version stats
unc0rr
parents: 8371
diff changeset
    45
allRoomsS = gets roomsClients >>= liftIO . roomsM
170afc3ac39f Also rooms per version stats
unc0rr
parents: 8371
diff changeset
    46
4989
4771fed9272e - Write server config into .ini file on change
unc0rr
parents: 4975
diff changeset
    47
roomClientsS :: RoomIndex -> StateT ServerState IO [ClientInfo]
3502
ad38c653b7d9 Some more progress
unc0rr
parents: 3501
diff changeset
    48
roomClientsS ri = do
ad38c653b7d9 Some more progress
unc0rr
parents: 3501
diff changeset
    49
    rnc <- gets roomsClients
4622
8bdc879ee6b2 Implement room delegation when admin lefts it
unc0rr
parents: 4601
diff changeset
    50
    io $ roomClientsM rnc ri
4601
08ae94dd4c0d io = liftIO
unc0rr
parents: 3807
diff changeset
    51
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
    52
sameProtoClientsS :: Word16 -> StateT ServerState IO [ClientInfo]
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
sameProtoClientsS p = liftM f allClientsS
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
    where
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
        f = filter (\c -> clientProto c == p)
8371
0551b5c3de9a - Start work on checker
unc0rr
parents: 6541
diff changeset
    56
4989
4771fed9272e - Write server config into .ini file on change
unc0rr
parents: 4975
diff changeset
    57
io :: IO a -> StateT ServerState IO a
4601
08ae94dd4c0d io = liftIO
unc0rr
parents: 3807
diff changeset
    58
io = liftIO