gameServer/CoreTypes.hs
author unc0rr
Mon, 18 Feb 2013 00:28:09 +0400
changeset 8510 0a39b2f9c748
parent 8509 eda9f2106d8d
child 8519 98e2dbdda8c0
permissions -rw-r--r--
No NFData instance for ByteString when ghc >= 7.6
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
4959
09f4978b4fb0 ShutdownException for server shutdown
unc0rr
parents: 4957
diff changeset
     1
{-# LANGUAGE 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
4959
09f4978b4fb0 ShutdownException for server shutdown
unc0rr
parents: 4957
diff changeset
    15
-----------------------
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
    16
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
    17
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
type ClientChan = Chan [B.ByteString]
3435
4e4f88a7bdf2 Some more steps in refactoring
unc0rr
parents: 3425
diff changeset
    19
8507
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    20
data CheckInfo =
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    21
    CheckInfo
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    22
    {
8509
eda9f2106d8d Sort checked files into dirs
unc0rr
parents: 8507
diff changeset
    23
        recordFileName :: String,
8507
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    24
        recordTeams :: [TeamInfo]
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    25
    }
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    26
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    27
data ClientInfo =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    28
    ClientInfo
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    29
    {
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
    30
        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
    31
        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
    32
        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
    33
        host :: B.ByteString,
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    34
        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
    35
        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
    36
        webPassword :: B.ByteString,
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    37
        logonPassed :: Bool,
8372
3c193ec03e09 Logon procedure for checkers, introduce invisible clients
unc0rr
parents: 8371
diff changeset
    38
        isVisible :: Bool,
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    39
        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
    40
        roomID :: RoomIndex,
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    41
        pingsQueue :: !Word,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    42
        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
    43
        isReady :: !Bool,
7757
c20e6c80e249 Don't accept ROUNDFINISHED message twice. Fixes game hangs when half of teams quit game.
unc0rr
parents: 7537
diff changeset
    44
        isInGame :: Bool,
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    45
        isAdministrator :: Bool,
8371
0551b5c3de9a - Start work on checker
unc0rr
parents: 8369
diff changeset
    46
        isChecker :: Bool,
8245
d1a830c304c7 Change room name if room admin is kicked
unc0rr
parents: 8232
diff changeset
    47
        isKickedFromServer :: Bool,
8433
3b318a130a62 Some fixes
unc0rr
parents: 8431
diff changeset
    48
        clientClan :: !(Maybe B.ByteString),
8507
f4475782cf45 Some more work on checker
unc0rr
parents: 8479
diff changeset
    49
        checkInfo :: Maybe CheckInfo,
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    50
        teamsInGame :: Word
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    51
    }
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    52
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    53
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
    54
    (==) = (==) `on` clientSocket
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    55
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    56
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
    57
    HedgehogInfo B.ByteString B.ByteString
5143
649d87819682 Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents: 5007
diff changeset
    58
    deriving (Show, Read)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    59
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    60
data TeamInfo =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    61
    TeamInfo
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    62
    {
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
    63
        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
    64
        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
    65
        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
    66
        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
    67
        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
    68
        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
    69
        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
    70
        teamflag :: B.ByteString,
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    71
        difficulty :: Int,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    72
        hhnum :: Int,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    73
        hedgehogs :: [HedgehogInfo]
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
    74
    }
5143
649d87819682 Start implementation of archivements/ratings on server side: replay saving routine
unc0rr
parents: 5007
diff changeset
    75
    deriving (Show, Read)
7321
57bd4f201401 - Try sending remove message in 'finally' as a last resort
unc0rr
parents: 7126
diff changeset
    76
8431
74c2c95ab07b Fix finding player's another clan
unc0rr
parents: 8428
diff changeset
    77
instance Eq TeamInfo where
74c2c95ab07b Fix finding player's another clan
unc0rr
parents: 8428
diff changeset
    78
    (==) = (==) `on` teamname
8479
8d71109b04d2 Some work on loading replay and interaction with checker
unc0rr
parents: 8433
diff changeset
    79
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
    80
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
    81
    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
    82
    {
8369
31033e521653 Throw away stupid Data.Seq
unc0rr
parents: 8245
diff changeset
    83
        roundMsgs :: [B.ByteString],
7126
8daa5c8e84c0 Bring leftTeams back (with a fix) as it is apparently needed for spectators.
unc0rr
parents: 7124
diff changeset
    84
        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
    85
        teamsAtStart :: [TeamInfo],
6756
344d32bb1328 Also consider game finished when the last player reports ROUNDFINISHED despite the correctness parameter.
unc0rr
parents: 6737
diff changeset
    86
        teamsInGameNumber :: Int,
8428
73ab5a17ee55 Fix crashers
unc0rr
parents: 8372
diff changeset
    87
        allPlayersHaveRegisteredAccounts :: !Bool,
6069
d59745e525ec GameInfo needs room params copy
unc0rr
parents: 5996
diff changeset
    88
        giMapParams :: Map.Map B.ByteString B.ByteString,
d59745e525ec GameInfo needs room params copy
unc0rr
parents: 5996
diff changeset
    89
        giParams :: Map.Map B.ByteString [B.ByteString]
d59745e525ec GameInfo needs room params copy
unc0rr
parents: 5996
diff changeset
    90
    } deriving (Show, Read)
7321
57bd4f201401 - Try sending remove message in 'finally' as a last resort
unc0rr
parents: 7126
diff changeset
    91
7766
98edc0724a28 Fix most of server warnings
unc0rr
parents: 7757
diff changeset
    92
newGameInfo :: [TeamInfo]
98edc0724a28 Fix most of server warnings
unc0rr
parents: 7757
diff changeset
    93
                -> Int
98edc0724a28 Fix most of server warnings
unc0rr
parents: 7757
diff changeset
    94
                -> Bool
98edc0724a28 Fix most of server warnings
unc0rr
parents: 7757
diff changeset
    95
                -> Map.Map ByteString ByteString
98edc0724a28 Fix most of server warnings
unc0rr
parents: 7757
diff changeset
    96
                -> Map.Map ByteString [ByteString]
98edc0724a28 Fix most of server warnings
unc0rr
parents: 7757
diff changeset
    97
                -> GameInfo
7321
57bd4f201401 - Try sending remove message in 'finally' as a last resort
unc0rr
parents: 7126
diff changeset
    98
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
    99
    GameInfo
8369
31033e521653 Throw away stupid Data.Seq
unc0rr
parents: 8245
diff changeset
   100
        []
7126
8daa5c8e84c0 Bring leftTeams back (with a fix) as it is apparently needed for spectators.
unc0rr
parents: 7124
diff changeset
   101
        []
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   102
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   103
data RoomInfo =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   104
    RoomInfo
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   105
    {
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
   106
        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
   107
        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
   108
        password :: B.ByteString,
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   109
        roomProto :: Word16,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   110
        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
   111
        gameInfo :: Maybe GameInfo,
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   112
        playersIn :: !Int,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   113
        readyPlayers :: !Int,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   114
        isRestrictedJoins :: Bool,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   115
        isRestrictedTeams :: Bool,
8232
fb5aa767a2a0 "Registered users only" room flag
unc0rr
parents: 8002
diff changeset
   116
        isRegisteredOnly :: Bool,
8002
8113afd3858f More strictness on room bans
unc0rr
parents: 7862
diff changeset
   117
        roomBansList :: ![B.ByteString],
4941
90572c338e60 Fix for my last commit (which was all nonsense)
unc0rr
parents: 4932
diff changeset
   118
        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
   119
        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
   120
    }
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   121
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
   122
newRoom :: RoomInfo
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4918
diff changeset
   123
newRoom =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   124
    RoomInfo
4987
cf9470964dba Use 'undefined' less (replace with default values and 'error')
unc0rr
parents: 4986
diff changeset
   125
        (error "No room master defined")
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   126
        ""
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   127
        ""
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   128
        0
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   129
        []
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
   130
        Nothing
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   131
        0
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   132
        0
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   133
        False
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   134
        False
8232
fb5aa767a2a0 "Registered users only" room flag
unc0rr
parents: 8002
diff changeset
   135
        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
   136
        []
4941
90572c338e60 Fix for my last commit (which was all nonsense)
unc0rr
parents: 4932
diff changeset
   137
        (
90572c338e60 Fix for my last commit (which was all nonsense)
unc0rr
parents: 4932
diff changeset
   138
            Map.fromList $ Prelude.zipWith (,)
90572c338e60 Fix for my last commit (which was all nonsense)
unc0rr
parents: 4932
diff changeset
   139
                ["MAP", "MAPGEN", "MAZE_SIZE", "SEED", "TEMPLATE"]
90572c338e60 Fix for my last commit (which was all nonsense)
unc0rr
parents: 4932
diff changeset
   140
                ["+rnd+", "0", "0", "seed", "0"]
90572c338e60 Fix for my last commit (which was all nonsense)
unc0rr
parents: 4932
diff changeset
   141
        )
90572c338e60 Fix for my last commit (which was all nonsense)
unc0rr
parents: 4932
diff changeset
   142
        (Map.singleton "SCHEME" ["Default"])
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   143
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   144
data StatisticsInfo =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   145
    StatisticsInfo
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   146
    {
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   147
        playersNumber :: Int,
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   148
        roomsNumber :: Int
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   149
    }
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   150
4989
4771fed9272e - Write server config into .ini file on change
unc0rr
parents: 4988
diff changeset
   151
data ServerInfo =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   152
    ServerInfo
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   153
    {
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   154
        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
   155
        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
   156
        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
   157
        latestReleaseVersion :: Word16,
4988
bd540ba66599 Store more parameters in ini file
unc0rr
parents: 4987
diff changeset
   158
        earliestCompatibleVersion :: Word16,
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   159
        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
   160
        dbHost :: B.ByteString,
4982
3572eaf14340 Add dbName parameter to .ini file, fix some warnings
unc0rr
parents: 4975
diff changeset
   161
        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
   162
        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
   163
        dbPassword :: B.ByteString,
5007
c401891fe5e0 Get rid of lastLogins, implement bans system
unc0rr
parents: 5006
diff changeset
   164
        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
   165
        shutdownPending :: Bool,
5210
a5329e52a71b Pass correct arguments on restart
unc0rr
parents: 5209
diff changeset
   166
        runArgs :: [String],
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   167
        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
   168
        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
   169
        serverSocket :: Maybe Socket,
4989
4771fed9272e - Write server config into .ini file on change
unc0rr
parents: 4988
diff changeset
   170
        serverConfig :: Maybe Conf
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   171
    }
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   172
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   173
5209
f7a610e2ef5f On restart command close server socket and spawn new server, keep running until last client quits
unc0rr
parents: 5143
diff changeset
   174
newServerInfo :: Chan CoreMessage -> Chan DBQuery -> Maybe Socket -> Maybe Conf -> ServerInfo
4932
f11d80bac7ed - Take into account hlint suggestions
unc0rr
parents: 4918
diff changeset
   175
newServerInfo =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   176
    ServerInfo
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   177
        True
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   178
        "<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
   179
        "<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
   180
        43 -- latestReleaseVersion
bd76ca40db68 Choose first unused color for added team (addresses issue 431) + other small changes
unc0rr
parents: 7766
diff changeset
   181
        41 -- earliestCompatibleVersion
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   182
        46631
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   183
        ""
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   184
        ""
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   185
        ""
4982
3572eaf14340 Add dbName parameter to .ini file, fix some warnings
unc0rr
parents: 4975
diff changeset
   186
        ""
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   187
        []
4955
84543ecae8c3 Don't forkIO main loop
unc0rr
parents: 4941
diff changeset
   188
        False
5210
a5329e52a71b Pass correct arguments on restart
unc0rr
parents: 5209
diff changeset
   189
        []
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   190
1839
5dd4cb7fd7e5 Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents: 1833
diff changeset
   191
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
   192
    HasAccount B.ByteString Bool
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   193
    | Guest
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   194
    | Admin
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   195
    deriving (Show, Read)
2116
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents: 2104
diff changeset
   196
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents: 2104
diff changeset
   197
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
   198
    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
   199
    | ClearCache
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   200
    | SendStats Int Int
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   201
    deriving (Show, Read)
1839
5dd4cb7fd7e5 Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents: 1833
diff changeset
   202
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   203
data CoreMessage =
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   204
    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
   205
    | 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
   206
    | ClientAccountInfo ClientIndex Int AccountInfo
2867
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev
unc0rr
parents: 2747
diff changeset
   207
    | 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
   208
    | Remove ClientIndex
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   209
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
   210
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
   211
type IRnC = IRoomsAndClients RoomInfo ClientInfo
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   212
4622
8bdc879ee6b2 Implement room delegation when admin lefts it
unc0rr
parents: 4610
diff changeset
   213
data Notice =
8bdc879ee6b2 Implement room delegation when admin lefts it
unc0rr
parents: 4610
diff changeset
   214
    NickAlreadyInUse
8bdc879ee6b2 Implement room delegation when admin lefts it
unc0rr
parents: 4610
diff changeset
   215
    | 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
   216
    | WrongPassword
4959
09f4978b4fb0 ShutdownException for server shutdown
unc0rr
parents: 4957
diff changeset
   217
    deriving Enum
09f4978b4fb0 ShutdownException for server shutdown
unc0rr
parents: 4957
diff changeset
   218
4960
unc0rr
parents: 4959
diff changeset
   219
data ShutdownException =
unc0rr
parents: 4959
diff changeset
   220
    ShutdownException
4959
09f4978b4fb0 ShutdownException for server shutdown
unc0rr
parents: 4957
diff changeset
   221
     deriving (Show, Typeable)
09f4978b4fb0 ShutdownException for server shutdown
unc0rr
parents: 4957
diff changeset
   222
09f4978b4fb0 ShutdownException for server shutdown
unc0rr
parents: 4957
diff changeset
   223
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
   224
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
   225
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
   226
     deriving Typeable
4996
76ef3d8bd78e Fix crash (accessing already deleted client record) by reverting to old client removing handling + throwTo
unc0rr
parents: 4989
diff changeset
   227
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
   228
instance Show ShutdownThreadException where
5001
312f4dd41753 Better quit message
unc0rr
parents: 5000
diff changeset
   229
    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
   230
instance Exception ShutdownThreadException
5006
6913d677c891 - Remove not needed Show instances
unc0rr
parents: 5001
diff changeset
   231
6913d677c891 - Remove not needed Show instances
unc0rr
parents: 5001
diff changeset
   232
data BanInfo =
5007
c401891fe5e0 Get rid of lastLogins, implement bans system
unc0rr
parents: 5006
diff changeset
   233
    BanByIP B.ByteString B.ByteString UTCTime
c401891fe5e0 Get rid of lastLogins, implement bans system
unc0rr
parents: 5006
diff changeset
   234
    | BanByNick B.ByteString B.ByteString UTCTime
5006
6913d677c891 - Remove not needed Show instances
unc0rr
parents: 5001
diff changeset
   235
    deriving (Show, Read)