gameServer/CoreTypes.hs
author nemo
Tue, 08 Sep 2009 19:44:49 +0000
changeset 2357 babe1a55e284
parent 2352 7eaf82cf0890
child 2403 6c5d504af2ba
permissions -rw-r--r--
Add an empty weapon to avoid selection of weapons which aren't yet ready. Might all be useful to switch to amNothing in certain situations, like after using up all ropes, instead of bazooka.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     1
module CoreTypes where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     2
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     3
import System.IO
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     4
import Control.Concurrent.Chan
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     5
import Control.Concurrent.STM
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     6
import Data.Word
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     7
import qualified Data.Map as Map
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     8
import qualified Data.IntMap as IntMap
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
     9
import qualified Data.IntSet as IntSet
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    10
import Data.Sequence(Seq, empty)
1926
cb46fbdcaa41 Add simple DoS protection mechanism (although better than previous server had)
unc0rr
parents: 1921
diff changeset
    11
import Data.Time
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    12
import Network
2352
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2245
diff changeset
    13
import Data.Function
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    14
1833
e901ec5644b4 Add options for configuring database access
unc0rr
parents: 1832
diff changeset
    15
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    16
data ClientInfo =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    17
 ClientInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    18
	{
2004
f7944d5adc5f Some work to try prevent stack memory leak
unc0rr
parents: 1986
diff changeset
    19
		clientUID :: !Int,
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    20
		sendChan :: Chan [String],
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    21
		clientHandle :: Handle,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    22
		host :: String,
1926
cb46fbdcaa41 Add simple DoS protection mechanism (although better than previous server had)
unc0rr
parents: 1921
diff changeset
    23
		connectTime :: UTCTime,
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    24
		nick :: String,
1841
fba7210b438b Retrieve client password from web database and ask for it
unc0rr
parents: 1839
diff changeset
    25
		webPassword :: String,
fba7210b438b Retrieve client password from web database and ask for it
unc0rr
parents: 1839
diff changeset
    26
		logonPassed :: Bool,
2004
f7944d5adc5f Some work to try prevent stack memory leak
unc0rr
parents: 1986
diff changeset
    27
		clientProto :: !Word16,
f7944d5adc5f Some work to try prevent stack memory leak
unc0rr
parents: 1986
diff changeset
    28
		roomID :: !Int,
f7944d5adc5f Some work to try prevent stack memory leak
unc0rr
parents: 1986
diff changeset
    29
		pingsQueue :: !Word,
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    30
		isMaster :: Bool,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    31
		isReady :: Bool,
2245
c011aecc95e5 unc0rr's patch from issue #144 - prevent spectators from ruining the game
nemo
parents: 2173
diff changeset
    32
		isAdministrator :: Bool,
c011aecc95e5 unc0rr's patch from issue #144 - prevent spectators from ruining the game
nemo
parents: 2173
diff changeset
    33
		teamsInGame :: Word
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    34
	}
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    35
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    36
instance Show ClientInfo where
2352
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2245
diff changeset
    37
	show ci = show (clientUID ci)
2004
f7944d5adc5f Some work to try prevent stack memory leak
unc0rr
parents: 1986
diff changeset
    38
			++ " nick: " ++ (nick ci)
f7944d5adc5f Some work to try prevent stack memory leak
unc0rr
parents: 1986
diff changeset
    39
			++ " host: " ++ (host ci)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    40
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    41
instance Eq ClientInfo where
2352
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2245
diff changeset
    42
	(==) = (==) `on` clientHandle
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    43
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    44
data HedgehogInfo =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    45
	HedgehogInfo String String
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    46
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    47
data TeamInfo =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    48
	TeamInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    49
	{
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    50
		teamowner :: String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    51
		teamname :: String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    52
		teamcolor :: String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    53
		teamgrave :: String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    54
		teamfort :: String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    55
		teamvoicepack :: String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    56
		difficulty :: Int,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    57
		hhnum :: Int,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    58
		hedgehogs :: [HedgehogInfo]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    59
	}
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    60
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    61
data RoomInfo =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    62
	RoomInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    63
	{
2004
f7944d5adc5f Some work to try prevent stack memory leak
unc0rr
parents: 1986
diff changeset
    64
		roomUID :: !Int,
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    65
		name :: String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    66
		password :: String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    67
		roomProto :: Word16,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    68
		teams :: [TeamInfo],
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    69
		gameinprogress :: Bool,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    70
		playersIn :: !Int,
2004
f7944d5adc5f Some work to try prevent stack memory leak
unc0rr
parents: 1986
diff changeset
    71
		readyPlayers :: !Int,
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    72
		playersIDs :: IntSet.IntSet,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    73
		isRestrictedJoins :: Bool,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    74
		isRestrictedTeams :: Bool,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    75
		roundMsgs :: Seq String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    76
		leftTeams :: [String],
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    77
		teamsAtStart :: [TeamInfo],
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    78
		params :: Map.Map String [String]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    79
	}
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    80
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    81
instance Show RoomInfo where
2352
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2245
diff changeset
    82
	show ri = show (roomUID ri)
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2245
diff changeset
    83
			++ ", players ids: " ++ show (IntSet.size $ playersIDs ri)
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2245
diff changeset
    84
			++ ", players: " ++ show (playersIn ri)
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2245
diff changeset
    85
			++ ", ready: " ++ show (readyPlayers ri)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    86
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    87
instance Eq RoomInfo where
2352
7eaf82cf0890 Fixes suggested by hlint tool
unc0rr
parents: 2245
diff changeset
    88
	(==) = (==) `on` roomUID
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    89
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    90
newRoom = (
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    91
	RoomInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    92
		0
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    93
		""
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    94
		""
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    95
		0
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    96
		[]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    97
		False
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    98
		0
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    99
		0
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   100
		IntSet.empty
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   101
		False
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   102
		False
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   103
		Data.Sequence.empty
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   104
		[]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   105
		[]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   106
		(Map.singleton "MAP" ["+rnd+"])
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   107
	)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   108
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   109
data StatisticsInfo =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   110
	StatisticsInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   111
	{
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   112
		playersNumber :: Int,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   113
		roomsNumber :: Int
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   114
	}
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   115
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   116
data ServerInfo =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   117
	ServerInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   118
	{
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   119
		isDedicated :: Bool,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   120
		serverMessage :: String,
1953
fd9c8e3c734d Add a special message for old hedgewars versions
unc0rr
parents: 1927
diff changeset
   121
		serverMessageForOldVersions :: String,
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   122
		listenPort :: PortNumber,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   123
		nextRoomID :: Int,
1832
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1824
diff changeset
   124
		dbHost :: String,
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1824
diff changeset
   125
		dbLogin :: String,
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1824
diff changeset
   126
		dbPassword :: String,
1926
cb46fbdcaa41 Add simple DoS protection mechanism (although better than previous server had)
unc0rr
parents: 1921
diff changeset
   127
		lastLogins :: [(String, UTCTime)],
1833
e901ec5644b4 Add options for configuring database access
unc0rr
parents: 1832
diff changeset
   128
		stats :: TMVar StatisticsInfo,
1839
5dd4cb7fd7e5 Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents: 1833
diff changeset
   129
		coreChan :: Chan CoreMessage,
1833
e901ec5644b4 Add options for configuring database access
unc0rr
parents: 1832
diff changeset
   130
		dbQueries :: Chan DBQuery
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   131
	}
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   132
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   133
instance Show ServerInfo where
2004
f7944d5adc5f Some work to try prevent stack memory leak
unc0rr
parents: 1986
diff changeset
   134
	show si = "Server Info"
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   135
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   136
newServerInfo = (
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   137
	ServerInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   138
		True
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   139
		"<h2><p align=center><a href=\"http://www.hedgewars.org/\">http://www.hedgewars.org/</a></p></h2>"
2104
b2c50a7480ea Update server's message
unc0rr
parents: 2004
diff changeset
   140
		"<font color=yellow><h3>Hedgewars 0.9.11 is out! Please, update.</h3><p align=center><a href=http://hedgewars.org/download.html>Download page here</a></p><h4>New features are:</h4><ul><li>Speech bubbles</li><li>New game modes</li><li>Sniper rifle</li><li>...</li></ul></font>"
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   141
		46631
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   142
		0
1832
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1824
diff changeset
   143
		""
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1824
diff changeset
   144
		""
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1824
diff changeset
   145
		""
1926
cb46fbdcaa41 Add simple DoS protection mechanism (although better than previous server had)
unc0rr
parents: 1921
diff changeset
   146
		[]
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   147
	)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   148
1839
5dd4cb7fd7e5 Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents: 1833
diff changeset
   149
data AccountInfo =
1847
2178c0fc838c Set admin flag and send admin notification to users with rid equal to 3
unc0rr
parents: 1841
diff changeset
   150
	HasAccount String Bool
1839
5dd4cb7fd7e5 Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents: 1833
diff changeset
   151
	| Guest
1921
2a09f7f786a0 - User from localhost is server admin
unc0rr
parents: 1847
diff changeset
   152
	| Admin
2116
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents: 2104
diff changeset
   153
	deriving (Show, Read)
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents: 2104
diff changeset
   154
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents: 2104
diff changeset
   155
data DBQuery =
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents: 2104
diff changeset
   156
	CheckAccount Int String String
2155
d897222d3339 Implement ability for server admin to clear accounts cache
unc0rr
parents: 2116
diff changeset
   157
	| ClearCache
2172
80d34c0b9dfe Implement sending gameserver stats to webserver
unc0rr
parents: 2155
diff changeset
   158
	| SendStats Int Int
2116
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents: 2104
diff changeset
   159
	deriving (Show, Read)
1839
5dd4cb7fd7e5 Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents: 1833
diff changeset
   160
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   161
data CoreMessage =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   162
	Accept ClientInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   163
	| ClientMessage (Int, [String])
2116
dec7ead2d178 Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents: 2104
diff changeset
   164
	| ClientAccountInfo (Int, AccountInfo)
2173
98cde8645e21 Send stats every minute
unc0rr
parents: 2172
diff changeset
   165
	| TimerAction Int
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   166
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   167
type Clients = IntMap.IntMap ClientInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   168
type Rooms = IntMap.IntMap RoomInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   169
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   170
--type ClientsTransform = [ClientInfo] -> [ClientInfo]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   171
--type RoomsTransform = [RoomInfo] -> [RoomInfo]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   172
--type HandlesSelector = ClientInfo -> [ClientInfo] -> [RoomInfo] -> [ClientInfo]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   173
--type Answer = ServerInfo -> (HandlesSelector, [String])
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   174
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   175
type ClientsSelector = Clients -> Rooms -> [Int]