gameServer/CoreTypes.hs
author unc0rr
Fri, 01 May 2009 09:01:44 +0000
changeset 2021 a591afb43768
parent 2004 f7944d5adc5f
child 2104 b2c50a7480ea
permissions -rw-r--r--
Some changes in try to fix issue when you enter room with painted map, but frontend shows generated one (most probably bug is triggered by template filters) Untested.
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
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    13
1833
e901ec5644b4 Add options for configuring database access
unc0rr
parents: 1832
diff changeset
    14
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    15
data ClientInfo =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    16
 ClientInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    17
	{
2004
f7944d5adc5f Some work to try prevent stack memory leak
unc0rr
parents: 1986
diff changeset
    18
		clientUID :: !Int,
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    19
		sendChan :: Chan [String],
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    20
		clientHandle :: Handle,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    21
		host :: String,
1926
cb46fbdcaa41 Add simple DoS protection mechanism (although better than previous server had)
unc0rr
parents: 1921
diff changeset
    22
		connectTime :: UTCTime,
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    23
		nick :: String,
1841
fba7210b438b Retrieve client password from web database and ask for it
unc0rr
parents: 1839
diff changeset
    24
		webPassword :: String,
fba7210b438b Retrieve client password from web database and ask for it
unc0rr
parents: 1839
diff changeset
    25
		logonPassed :: Bool,
2004
f7944d5adc5f Some work to try prevent stack memory leak
unc0rr
parents: 1986
diff changeset
    26
		clientProto :: !Word16,
f7944d5adc5f Some work to try prevent stack memory leak
unc0rr
parents: 1986
diff changeset
    27
		roomID :: !Int,
f7944d5adc5f Some work to try prevent stack memory leak
unc0rr
parents: 1986
diff changeset
    28
		pingsQueue :: !Word,
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    29
		isMaster :: Bool,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    30
		isReady :: Bool,
2004
f7944d5adc5f Some work to try prevent stack memory leak
unc0rr
parents: 1986
diff changeset
    31
		isAdministrator :: Bool
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    32
	}
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    33
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    34
instance Show ClientInfo where
2004
f7944d5adc5f Some work to try prevent stack memory leak
unc0rr
parents: 1986
diff changeset
    35
	show ci = (show $ clientUID ci)
f7944d5adc5f Some work to try prevent stack memory leak
unc0rr
parents: 1986
diff changeset
    36
			++ " nick: " ++ (nick ci)
f7944d5adc5f Some work to try prevent stack memory leak
unc0rr
parents: 1986
diff changeset
    37
			++ " host: " ++ (host ci)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    38
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    39
instance Eq ClientInfo where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    40
	a1 == a2 = clientHandle a1 == clientHandle a2
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    41
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    42
data HedgehogInfo =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    43
	HedgehogInfo String String
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    44
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    45
data TeamInfo =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    46
	TeamInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    47
	{
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    48
		teamowner :: String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    49
		teamname :: String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    50
		teamcolor :: String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    51
		teamgrave :: String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    52
		teamfort :: String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    53
		teamvoicepack :: String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    54
		difficulty :: Int,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    55
		hhnum :: Int,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    56
		hedgehogs :: [HedgehogInfo]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    57
	}
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    58
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    59
data RoomInfo =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    60
	RoomInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    61
	{
2004
f7944d5adc5f Some work to try prevent stack memory leak
unc0rr
parents: 1986
diff changeset
    62
		roomUID :: !Int,
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    63
		name :: String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    64
		password :: String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    65
		roomProto :: Word16,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    66
		teams :: [TeamInfo],
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    67
		gameinprogress :: Bool,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    68
		playersIn :: !Int,
2004
f7944d5adc5f Some work to try prevent stack memory leak
unc0rr
parents: 1986
diff changeset
    69
		readyPlayers :: !Int,
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    70
		playersIDs :: IntSet.IntSet,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    71
		isRestrictedJoins :: Bool,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    72
		isRestrictedTeams :: Bool,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    73
		roundMsgs :: Seq String,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    74
		leftTeams :: [String],
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    75
		teamsAtStart :: [TeamInfo],
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    76
		params :: Map.Map String [String]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    77
	}
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    78
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    79
instance Show RoomInfo where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    80
	show ri = (show $ roomUID ri)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    81
			++ ", players ids: " ++ (show $ IntSet.size $ playersIDs ri)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    82
			++ ", players: " ++ (show $ playersIn ri)
1824
fbe1fa777d68 More verbose dump
unc0rr
parents: 1804
diff changeset
    83
			++ ", ready: " ++ (show $ readyPlayers ri)
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    84
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    85
instance Eq RoomInfo where
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    86
	a1 == a2 = roomUID a1 == roomUID a2
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    87
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    88
newRoom = (
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    89
	RoomInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    90
		0
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    91
		""
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    92
		""
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    93
		0
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    94
		[]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    95
		False
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    96
		0
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    97
		0
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    98
		IntSet.empty
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
    99
		False
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   100
		False
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   101
		Data.Sequence.empty
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   102
		[]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   103
		[]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   104
		(Map.singleton "MAP" ["+rnd+"])
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   105
	)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   106
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   107
data StatisticsInfo =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   108
	StatisticsInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   109
	{
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   110
		playersNumber :: Int,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   111
		roomsNumber :: Int
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   112
	}
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   113
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   114
data ServerInfo =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   115
	ServerInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   116
	{
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   117
		isDedicated :: Bool,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   118
		serverMessage :: String,
1953
fd9c8e3c734d Add a special message for old hedgewars versions
unc0rr
parents: 1927
diff changeset
   119
		serverMessageForOldVersions :: String,
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   120
		listenPort :: PortNumber,
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   121
		nextRoomID :: Int,
1832
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1824
diff changeset
   122
		dbHost :: String,
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1824
diff changeset
   123
		dbLogin :: String,
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1824
diff changeset
   124
		dbPassword :: String,
1926
cb46fbdcaa41 Add simple DoS protection mechanism (although better than previous server had)
unc0rr
parents: 1921
diff changeset
   125
		lastLogins :: [(String, UTCTime)],
1833
e901ec5644b4 Add options for configuring database access
unc0rr
parents: 1832
diff changeset
   126
		stats :: TMVar StatisticsInfo,
1839
5dd4cb7fd7e5 Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents: 1833
diff changeset
   127
		coreChan :: Chan CoreMessage,
1833
e901ec5644b4 Add options for configuring database access
unc0rr
parents: 1832
diff changeset
   128
		dbQueries :: Chan DBQuery
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   129
	}
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   130
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   131
instance Show ServerInfo where
2004
f7944d5adc5f Some work to try prevent stack memory leak
unc0rr
parents: 1986
diff changeset
   132
	show si = "Server Info"
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   133
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   134
newServerInfo = (
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   135
	ServerInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   136
		True
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   137
		"<h2><p align=center><a href=\"http://www.hedgewars.org/\">http://www.hedgewars.org/</a></p></h2>"
1986
15e612c68ea8 Update changelog in server
unc0rr
parents: 1953
diff changeset
   138
		"<font color=yellow><h3>Hedgewars 0.9.10 is out! Please, update. Support for previous versions IS DROPPED</h3><p align=center><a href=http://hedgewars.org/download.html>Download page here</a></p><h4>New features are:</h4><ul><li>Large maps</li><li>New game options</li><li>Utilities</li><li>...</li></ul></font>"
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   139
		46631
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   140
		0
1832
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1824
diff changeset
   141
		""
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1824
diff changeset
   142
		""
1fb61a53a2c2 Add options for database access
unc0rr
parents: 1824
diff changeset
   143
		""
1926
cb46fbdcaa41 Add simple DoS protection mechanism (although better than previous server had)
unc0rr
parents: 1921
diff changeset
   144
		[]
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   145
	)
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   146
1839
5dd4cb7fd7e5 Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents: 1833
diff changeset
   147
data AccountInfo =
1847
2178c0fc838c Set admin flag and send admin notification to users with rid equal to 3
unc0rr
parents: 1841
diff changeset
   148
	HasAccount String Bool
1839
5dd4cb7fd7e5 Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents: 1833
diff changeset
   149
	| Guest
1921
2a09f7f786a0 - User from localhost is server admin
unc0rr
parents: 1847
diff changeset
   150
	| Admin
1839
5dd4cb7fd7e5 Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents: 1833
diff changeset
   151
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   152
data CoreMessage =
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   153
	Accept ClientInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   154
	| ClientMessage (Int, [String])
1839
5dd4cb7fd7e5 Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents: 1833
diff changeset
   155
	| ClientAccountInfo Int AccountInfo
1927
e2031906a347 Ping clients every 30 seconds. Disconnection due to ping timeout to be implemented.
unc0rr
parents: 1926
diff changeset
   156
	| TimerAction
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   157
1833
e901ec5644b4 Add options for configuring database access
unc0rr
parents: 1832
diff changeset
   158
data DBQuery =
1921
2a09f7f786a0 - User from localhost is server admin
unc0rr
parents: 1847
diff changeset
   159
	CheckAccount ClientInfo
1833
e901ec5644b4 Add options for configuring database access
unc0rr
parents: 1832
diff changeset
   160
1804
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   161
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   162
type Clients = IntMap.IntMap ClientInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   163
type Rooms = IntMap.IntMap RoomInfo
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   164
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   165
--type ClientsTransform = [ClientInfo] -> [ClientInfo]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   166
--type RoomsTransform = [RoomInfo] -> [RoomInfo]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   167
--type HandlesSelector = ClientInfo -> [ClientInfo] -> [RoomInfo] -> [ClientInfo]
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   168
--type Answer = ServerInfo -> (HandlesSelector, [String])
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   169
4e78ad846fb6 New game server:
unc0rr
parents:
diff changeset
   170
type ClientsSelector = Clients -> Rooms -> [Int]