gameServer/CoreTypes.hs
author koda
Sat, 09 Mar 2013 00:57:09 +0100
changeset 8702 a28966180a29
parent 8519 98e2dbdda8c0
child 8897 d6c310c65c91
permissions -rw-r--r--
have fpc work in the right directory instead of passing the full path of the main module (avoids having full paths in debug build backtraces for the first module only)
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
8519
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
     1
{-# LANGUAGE CPP, OverloadedStrings, DeriveDataTypeable #-}
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     2
module CoreTypes where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     3
4579
4e61c2a42121 Explicitly kill listening thread in try to prevent messages recieving bugs
unc0rr
parents: 4337
diff changeset
     4
import Control.Concurrent
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     5
import Data.Word
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     6
import qualified Data.Map as Map
1926
cb46fbdcaa41 Add simple DoS protection mechanism (although better than previous server had)
unc0rr
parents: 1921
diff changeset
     7
import Data.Time
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     8
import Network
2352
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2245
diff changeset
     9
import Data.Function
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 Data.ByteString.Char8 as B
4918
c6d3aec73f93 Add Unique field to Client structure, and use it to check for matching recieved account status with client
unc0rr
parents: 4907
diff changeset
    11
import Data.Unique
4959
09f4978b4fb0 ShutdownException for server shutdown
unc0rr
parents: 4957
diff changeset
    12
import Control.Exception
09f4978b4fb0 ShutdownException for server shutdown
unc0rr
parents: 4957
diff changeset
    13
import Data.Typeable
4989
4771fed9272e - Write server config into .ini file on change
unc0rr
parents: 4988
diff changeset
    14
import Data.TConfig
8519
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    15
import Control.DeepSeq
4959
09f4978b4fb0 ShutdownException for server shutdown
unc0rr
parents: 4957
diff changeset
    16
-----------------------
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
    17
import RoomsAndClients
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
8519
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    19
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    20
#if __GLASGOW_HASKELL__ < 706
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    21
instance NFData B.ByteString
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    22
#endif
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    23
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    24
instance NFData (Chan a)
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    25
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    26
instance NFData Action where
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    27
    rnf (AnswerClients chans msg) = chans `deepseq` msg `deepseq` ()
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    28
    rnf a = a `seq` ()
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    29
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    30
data Action =
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    31
    AnswerClients ![ClientChan] ![B.ByteString]
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    32
    | SendServerMessage
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    33
    | SendServerVars
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    34
    | MoveToRoom RoomIndex
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    35
    | MoveToLobby B.ByteString
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    36
    | RemoveTeam B.ByteString
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    37
    | SendTeamRemovalMessage B.ByteString
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    38
    | RemoveRoom
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    39
    | FinishGame
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    40
    | UnreadyRoomClients
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    41
    | JoinLobby
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    42
    | ProtocolError B.ByteString
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    43
    | Warning B.ByteString
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    44
    | NoticeMessage Notice
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    45
    | ByeClient B.ByteString
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    46
    | KickClient ClientIndex
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    47
    | KickRoomClient ClientIndex
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    48
    | BanClient NominalDiffTime B.ByteString ClientIndex
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    49
    | BanIP B.ByteString NominalDiffTime B.ByteString
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    50
    | BanNick B.ByteString NominalDiffTime B.ByteString
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    51
    | BanList
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    52
    | Unban B.ByteString
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    53
    | ChangeMaster (Maybe ClientIndex)
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    54
    | RemoveClientTeams
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    55
    | ModifyClient (ClientInfo -> ClientInfo)
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    56
    | ModifyClient2 ClientIndex (ClientInfo -> ClientInfo)
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    57
    | ModifyRoomClients (ClientInfo -> ClientInfo)
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    58
    | ModifyRoom (RoomInfo -> RoomInfo)
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    59
    | ModifyServerInfo (ServerInfo -> ServerInfo)
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    60
    | AddRoom B.ByteString B.ByteString
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    61
    | SendUpdateOnThisRoom
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    62
    | CheckRegistered
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    63
    | ClearAccountsCache
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    64
    | ProcessAccountInfo AccountInfo
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    65
    | AddClient ClientInfo
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    66
    | DeleteClient ClientIndex
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    67
    | PingAll
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    68
    | StatsAction
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    69
    | RestartServer
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    70
    | AddNick2Bans B.ByteString B.ByteString UTCTime
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    71
    | AddIP2Bans B.ByteString B.ByteString UTCTime
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    72
    | CheckBanned Bool
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    73
    | SaveReplay
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    74
    | Stats
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    75
    | CheckRecord
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    76
    | CheckFailed B.ByteString
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    77
    | CheckSuccess [B.ByteString]
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
    78
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
    79
type ClientChan = Chan [B.ByteString]
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 3425
diff changeset
    80
8507
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    81
data CheckInfo =
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    82
    CheckInfo
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    83
    {
8509
eda9f2106d8d Sort checked files into dirs
unc0rr
parents: 8507
diff changeset
    84
        recordFileName :: String,
8507
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    85
        recordTeams :: [TeamInfo]
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    86
    }
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    87
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    88
data ClientInfo =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    89
    ClientInfo
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    90
    {
4918
c6d3aec73f93 Add Unique field to Client structure, and use it to check for matching recieved account status with client
unc0rr
parents: 4907
diff changeset
    91
        clUID :: Unique,
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
    92
        sendChan :: ClientChan,
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
    93
        clientSocket :: Socket,
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
    94
        host :: B.ByteString,
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    95
        connectTime :: UTCTime,
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
    96
        nick :: B.ByteString,
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
    97
        webPassword :: B.ByteString,
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    98
        logonPassed :: Bool,
8372
3c193ec03e09 Logon procedure for checkers, introduce invisible clients
unc0rr
parents: 8371
diff changeset
    99
        isVisible :: Bool,
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   100
        clientProto :: !Word16,
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
   101
        roomID :: RoomIndex,
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   102
        pingsQueue :: !Word,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   103
        isMaster :: Bool,
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
   104
        isReady :: !Bool,
7757
c20e6c80e249 Don't accept ROUNDFINISHED message twice. Fixes game hangs when half of teams quit game.
unc0rr
parents: 7537
diff changeset
   105
        isInGame :: Bool,
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   106
        isAdministrator :: Bool,
8371
0551b5c3de9a - Start work on checker
unc0rr
parents: 8369
diff changeset
   107
        isChecker :: Bool,
8245
d1a830c304c7 Change room name if room admin is kicked
unc0rr
parents: 8232
diff changeset
   108
        isKickedFromServer :: Bool,
8433
3b318a130a62 Some fixes
unc0rr
parents: 8431
diff changeset
   109
        clientClan :: !(Maybe B.ByteString),
8507
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
   110
        checkInfo :: Maybe CheckInfo,
8519
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
   111
        teamsInGame :: Word,
98e2dbdda8c0 Workaround desync issue if I correctly understand its roots (barely tested)
unc0rr
parents: 8509
diff changeset
   112
        actionsPending :: [Action]
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   113
    }
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   114
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   115
instance Eq ClientInfo where
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
   116
    (==) = (==) `on` clientSocket
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   117
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   118
data HedgehogInfo =
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
   119
    HedgehogInfo B.ByteString B.ByteString
5143
649d87819682 Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents: 5007
diff changeset
   120
    deriving (Show, Read)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   121
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   122
data TeamInfo =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   123
    TeamInfo
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   124
    {
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
   125
        teamownerId :: ClientIndex,
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
   126
        teamowner :: B.ByteString,
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
   127
        teamname :: B.ByteString,
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
   128
        teamcolor :: B.ByteString,
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
   129
        teamgrave :: B.ByteString,
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
   130
        teamfort :: B.ByteString,
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
   131
        teamvoicepack :: B.ByteString,
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
   132
        teamflag :: B.ByteString,
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   133
        difficulty :: Int,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   134
        hhnum :: Int,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   135
        hedgehogs :: [HedgehogInfo]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   136
    }
5143
649d87819682 Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents: 5007
diff changeset
   137
    deriving (Show, Read)
7321
57bd4f201401 - Try sending remove message in 'finally' as a last resort
unc0rr
parents: 7126
diff changeset
   138
8431
74c2c95ab07b Fix finding player's another clan
unc0rr
parents: 8428
diff changeset
   139
instance Eq TeamInfo where
74c2c95ab07b Fix finding player's another clan
unc0rr
parents: 8428
diff changeset
   140
    (==) = (==) `on` teamname
8479
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 8433
diff changeset
   141
5996
2c72fe81dd37 Convert boolean variable + a bunch of fields which make sense only while game is going on into Maybe + structure
unc0rr
parents: 5210
diff changeset
   142
data GameInfo =
2c72fe81dd37 Convert boolean variable + a bunch of fields which make sense only while game is going on into Maybe + structure
unc0rr
parents: 5210
diff changeset
   143
    GameInfo
2c72fe81dd37 Convert boolean variable + a bunch of fields which make sense only while game is going on into Maybe + structure
unc0rr
parents: 5210
diff changeset
   144
    {
8369
31033e521653 Throw away stupid Data.Seq
unc0rr
parents: 8245
diff changeset
   145
        roundMsgs :: [B.ByteString],
7126
8daa5c8e84c0 Bring leftTeams back (with a fix) as it is apparently needed for spectators.
unc0rr
parents: 7124
diff changeset
   146
        leftTeams :: [B.ByteString],
5996
2c72fe81dd37 Convert boolean variable + a bunch of fields which make sense only while game is going on into Maybe + structure
unc0rr
parents: 5210
diff changeset
   147
        teamsAtStart :: [TeamInfo],
6756
344d32bb1328 Also consider game finished when the last player reports ROUNDFINISHED despite the correctness parameter.
unc0rr
parents: 6737
diff changeset
   148
        teamsInGameNumber :: Int,
8428
73ab5a17ee55 Fix crashers
unc0rr
parents: 8372
diff changeset
   149
        allPlayersHaveRegisteredAccounts :: !Bool,
6069
d59745e525ec GameInfo needs room params copy
unc0rr
parents: 5996
diff changeset
   150
        giMapParams :: Map.Map B.ByteString B.ByteString,
d59745e525ec GameInfo needs room params copy
unc0rr
parents: 5996
diff changeset
   151
        giParams :: Map.Map B.ByteString [B.ByteString]
d59745e525ec GameInfo needs room params copy
unc0rr
parents: 5996
diff changeset
   152
    } deriving (Show, Read)
7321
57bd4f201401 - Try sending remove message in 'finally' as a last resort
unc0rr
parents: 7126
diff changeset
   153
7766
98edc0724a28 Fix most of server warnings
unc0rr
parents: 7757
diff changeset
   154
newGameInfo :: [TeamInfo]
98edc0724a28 Fix most of server warnings
unc0rr
parents: 7757
diff changeset
   155
                -> Int
98edc0724a28 Fix most of server warnings
unc0rr
parents: 7757
diff changeset
   156
                -> Bool
98edc0724a28 Fix most of server warnings
unc0rr
parents: 7757
diff changeset
   157
                -> Map.Map ByteString ByteString
98edc0724a28 Fix most of server warnings
unc0rr
parents: 7757
diff changeset
   158
                -> Map.Map ByteString [ByteString]
98edc0724a28 Fix most of server warnings
unc0rr
parents: 7757
diff changeset
   159
                -> GameInfo
7321
57bd4f201401 - Try sending remove message in 'finally' as a last resort
unc0rr
parents: 7126
diff changeset
   160
newGameInfo =
5996
2c72fe81dd37 Convert boolean variable + a bunch of fields which make sense only while game is going on into Maybe + structure
unc0rr
parents: 5210
diff changeset
   161
    GameInfo
8369
31033e521653 Throw away stupid Data.Seq
unc0rr
parents: 8245
diff changeset
   162
        []
7126
8daa5c8e84c0 Bring leftTeams back (with a fix) as it is apparently needed for spectators.
unc0rr
parents: 7124
diff changeset
   163
        []
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   164
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   165
data RoomInfo =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   166
    RoomInfo
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   167
    {
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
   168
        masterID :: ClientIndex,
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
   169
        name :: B.ByteString,
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
   170
        password :: B.ByteString,
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   171
        roomProto :: Word16,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   172
        teams :: [TeamInfo],
5996
2c72fe81dd37 Convert boolean variable + a bunch of fields which make sense only while game is going on into Maybe + structure
unc0rr
parents: 5210
diff changeset
   173
        gameInfo :: Maybe GameInfo,
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   174
        playersIn :: !Int,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   175
        readyPlayers :: !Int,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   176
        isRestrictedJoins :: Bool,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   177
        isRestrictedTeams :: Bool,
8232
fb5aa767a2a0 "Registered users only" room flag
unc0rr
parents: 8002
diff changeset
   178
        isRegisteredOnly :: Bool,
8002
8113afd3858f More strictness on room bans
unc0rr
parents: 7862
diff changeset
   179
        roomBansList :: ![B.ByteString],
4941
90572c338e60 Fix for my last commit (which was all nonsense)
unc0rr
parents: 4932
diff changeset
   180
        mapParams :: Map.Map B.ByteString B.ByteString,
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
   181
        params :: Map.Map B.ByteString [B.ByteString]
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   182
    }
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   183
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
   184
newRoom :: RoomInfo
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4918
diff changeset
   185
newRoom =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   186
    RoomInfo
4987
cf9470964dba Use 'undefined' less (replace with default values and 'error')
unc0rr
parents: 4986
diff changeset
   187
        (error "No room master defined")
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   188
        ""
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   189
        ""
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   190
        0
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   191
        []
5996
2c72fe81dd37 Convert boolean variable + a bunch of fields which make sense only while game is going on into Maybe + structure
unc0rr
parents: 5210
diff changeset
   192
        Nothing
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   193
        0
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   194
        0
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   195
        False
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   196
        False
8232
fb5aa767a2a0 "Registered users only" room flag
unc0rr
parents: 8002
diff changeset
   197
        False
7537
833a0c34fafc Room bans. They're more simple, than the global ones: if you ban someone, he is banned by ip in this room for the rest of the room lifetime. Not tested.
unc0rr
parents: 7321
diff changeset
   198
        []
4941
90572c338e60 Fix for my last commit (which was all nonsense)
unc0rr
parents: 4932
diff changeset
   199
        (
90572c338e60 Fix for my last commit (which was all nonsense)
unc0rr
parents: 4932
diff changeset
   200
            Map.fromList $ Prelude.zipWith (,)
90572c338e60 Fix for my last commit (which was all nonsense)
unc0rr
parents: 4932
diff changeset
   201
                ["MAP", "MAPGEN", "MAZE_SIZE", "SEED", "TEMPLATE"]
90572c338e60 Fix for my last commit (which was all nonsense)
unc0rr
parents: 4932
diff changeset
   202
                ["+rnd+", "0", "0", "seed", "0"]
90572c338e60 Fix for my last commit (which was all nonsense)
unc0rr
parents: 4932
diff changeset
   203
        )
90572c338e60 Fix for my last commit (which was all nonsense)
unc0rr
parents: 4932
diff changeset
   204
        (Map.singleton "SCHEME" ["Default"])
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   205
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   206
data StatisticsInfo =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   207
    StatisticsInfo
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   208
    {
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   209
        playersNumber :: Int,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   210
        roomsNumber :: Int
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   211
    }
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   212
4989
4771fed9272e - Write server config into .ini file on change
unc0rr
parents: 4988
diff changeset
   213
data ServerInfo =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   214
    ServerInfo
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   215
    {
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   216
        isDedicated :: Bool,
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
   217
        serverMessage :: B.ByteString,
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
   218
        serverMessageForOldVersions :: B.ByteString,
3260
b44b88908758 Allow to set motd for old client versions (not used yet, as server needs some refactoring)
unc0rr
parents: 2868
diff changeset
   219
        latestReleaseVersion :: Word16,
4988
bd540ba66599 Store more parameters in ini file
unc0rr
parents: 4987
diff changeset
   220
        earliestCompatibleVersion :: Word16,
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   221
        listenPort :: PortNumber,
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
   222
        dbHost :: B.ByteString,
4982
3572eaf14340 Add dbName parameter to .ini file, fix some warnings
unc0rr
parents: 4975
diff changeset
   223
        dbName :: B.ByteString,
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
   224
        dbLogin :: B.ByteString,
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
   225
        dbPassword :: B.ByteString,
5007
c401891fe5e0 Get rid of lastLogins, implement bans system
unc0rr
parents: 5006
diff changeset
   226
        bans :: [BanInfo],
5209
f7a610e2ef5f On restart command close server socket and spawn new server, keep running until last client quits
unc0rr
parents: 5143
diff changeset
   227
        shutdownPending :: Bool,
5210
a5329e52a71b Pass correct arguments on restart
unc0rr
parents: 5209
diff changeset
   228
        runArgs :: [String],
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   229
        coreChan :: Chan CoreMessage,
4975
31da8979e5b1 Use Data.TConfig to read and store server config in hedgewars.ini (a little bit of hate to the author for not exporting Conf type)
unc0rr
parents: 4960
diff changeset
   230
        dbQueries :: Chan DBQuery,
5209
f7a610e2ef5f On restart command close server socket and spawn new server, keep running until last client quits
unc0rr
parents: 5143
diff changeset
   231
        serverSocket :: Maybe Socket,
4989
4771fed9272e - Write server config into .ini file on change
unc0rr
parents: 4988
diff changeset
   232
        serverConfig :: Maybe Conf
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   233
    }
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   234
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   235
5209
f7a610e2ef5f On restart command close server socket and spawn new server, keep running until last client quits
unc0rr
parents: 5143
diff changeset
   236
newServerInfo :: Chan CoreMessage -> Chan DBQuery -> Maybe Socket -> Maybe Conf -> ServerInfo
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4918
diff changeset
   237
newServerInfo =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   238
    ServerInfo
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   239
        True
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   240
        "<h2><p align=center><a href=\"http://www.hedgewars.org/\">http://www.hedgewars.org/</a></p></h2>"
7862
bd76ca40db68 Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents: 7766
diff changeset
   241
        "<font color=yellow><h3 align=center>Hedgewars 0.9.18 is out! Please update.</h3><p align=center><a href=http://hedgewars.org/download.html>Download page here</a></font>"
bd76ca40db68 Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents: 7766
diff changeset
   242
        43 -- latestReleaseVersion
bd76ca40db68 Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents: 7766
diff changeset
   243
        41 -- earliestCompatibleVersion
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   244
        46631
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   245
        ""
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   246
        ""
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   247
        ""
4982
3572eaf14340 Add dbName parameter to .ini file, fix some warnings
unc0rr
parents: 4975
diff changeset
   248
        ""
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   249
        []
4955
84543ecae8c3 Don't forkIO main loop
unc0rr
parents: 4941
diff changeset
   250
        False
5210
a5329e52a71b Pass correct arguments on restart
unc0rr
parents: 5209
diff changeset
   251
        []
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   252
1839
5dd4cb7fd7e5 Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents: 1833
diff changeset
   253
data AccountInfo =
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
   254
    HasAccount B.ByteString Bool
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   255
    | Guest
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   256
    | Admin
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   257
    deriving (Show, Read)
2116
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents: 2104
diff changeset
   258
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents: 2104
diff changeset
   259
data DBQuery =
4918
c6d3aec73f93 Add Unique field to Client structure, and use it to check for matching recieved account status with client
unc0rr
parents: 4907
diff changeset
   260
    CheckAccount ClientIndex Int B.ByteString B.ByteString
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   261
    | ClearCache
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   262
    | SendStats Int Int
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   263
    deriving (Show, Read)
1839
5dd4cb7fd7e5 Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents: 1833
diff changeset
   264
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   265
data CoreMessage =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   266
    Accept ClientInfo
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
   267
    | ClientMessage (ClientIndex, [B.ByteString])
4918
c6d3aec73f93 Add Unique field to Client structure, and use it to check for matching recieved account status with client
unc0rr
parents: 4907
diff changeset
   268
    | ClientAccountInfo ClientIndex Int AccountInfo
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   269
    | TimerAction Int
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
   270
    | Remove ClientIndex
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   271
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
   272
type MRnC = MRoomsAndClients RoomInfo ClientInfo
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
   273
type IRnC = IRoomsAndClients RoomInfo ClientInfo
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   274
4622
8bdc879ee6b2 Implement room delegation when admin lefts it
unc0rr
parents: 4610
diff changeset
   275
data Notice =
8bdc879ee6b2 Implement room delegation when admin lefts it
unc0rr
parents: 4610
diff changeset
   276
    NickAlreadyInUse
8bdc879ee6b2 Implement room delegation when admin lefts it
unc0rr
parents: 4610
diff changeset
   277
    | AdminLeft
6912
831416764d2d Allow LIST command while in room to not annoy old frontends (0.9.17 or less) with warnings
unc0rr
parents: 6756
diff changeset
   278
    | WrongPassword
4959
09f4978b4fb0 ShutdownException for server shutdown
unc0rr
parents: 4957
diff changeset
   279
    deriving Enum
09f4978b4fb0 ShutdownException for server shutdown
unc0rr
parents: 4957
diff changeset
   280
4960
unc0rr
parents: 4959
diff changeset
   281
data ShutdownException =
unc0rr
parents: 4959
diff changeset
   282
    ShutdownException
4959
09f4978b4fb0 ShutdownException for server shutdown
unc0rr
parents: 4957
diff changeset
   283
     deriving (Show, Typeable)
09f4978b4fb0 ShutdownException for server shutdown
unc0rr
parents: 4957
diff changeset
   284
09f4978b4fb0 ShutdownException for server shutdown
unc0rr
parents: 4957
diff changeset
   285
instance Exception ShutdownException
4996
76ef3d8bd78e Fix crash (accessing already deleted client record) by reverting to old client removing handling + throwTo
unc0rr
parents: 4989
diff changeset
   286
5000
72d8fb26223d - Don't pretend client sent some message from sending thread (fixes crash when client is already deleted by recieveng thread)
unc0rr
parents: 4996
diff changeset
   287
data ShutdownThreadException = ShutdownThreadException String
72d8fb26223d - Don't pretend client sent some message from sending thread (fixes crash when client is already deleted by recieveng thread)
unc0rr
parents: 4996
diff changeset
   288
     deriving Typeable
4996
76ef3d8bd78e Fix crash (accessing already deleted client record) by reverting to old client removing handling + throwTo
unc0rr
parents: 4989
diff changeset
   289
5000
72d8fb26223d - Don't pretend client sent some message from sending thread (fixes crash when client is already deleted by recieveng thread)
unc0rr
parents: 4996
diff changeset
   290
instance Show ShutdownThreadException where
5001
312f4dd41753 Better quit message
unc0rr
parents: 5000
diff changeset
   291
    show (ShutdownThreadException s) = s
4996
76ef3d8bd78e Fix crash (accessing already deleted client record) by reverting to old client removing handling + throwTo
unc0rr
parents: 4989
diff changeset
   292
instance Exception ShutdownThreadException
5006
6913d677c891 - Remove not needed Show instances
unc0rr
parents: 5001
diff changeset
   293
6913d677c891 - Remove not needed Show instances
unc0rr
parents: 5001
diff changeset
   294
data BanInfo =
5007
c401891fe5e0 Get rid of lastLogins, implement bans system
unc0rr
parents: 5006
diff changeset
   295
    BanByIP B.ByteString B.ByteString UTCTime
c401891fe5e0 Get rid of lastLogins, implement bans system
unc0rr
parents: 5006
diff changeset
   296
    | BanByNick B.ByteString B.ByteString UTCTime
5006
6913d677c891 - Remove not needed Show instances
unc0rr
parents: 5001
diff changeset
   297
    deriving (Show, Read)