author | koda |
Wed, 11 Nov 2009 19:48:16 +0000 | |
changeset 2615 | b86abe068708 |
parent 2551 | 01eb81cd3198 |
child 2631 | 163b0128bd21 |
permissions | -rw-r--r-- |
1804 | 1 |
module CoreTypes where |
2 |
||
3 |
import System.IO |
|
4 |
import Control.Concurrent.Chan |
|
5 |
import Control.Concurrent.STM |
|
6 |
import Data.Word |
|
7 |
import qualified Data.Map as Map |
|
8 |
import qualified Data.IntMap as IntMap |
|
9 |
import qualified Data.IntSet as IntSet |
|
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 | 12 |
import Network |
2352 | 13 |
import Data.Function |
1804 | 14 |
|
1833 | 15 |
|
1804 | 16 |
data ClientInfo = |
17 |
ClientInfo |
|
18 |
{ |
|
2004 | 19 |
clientUID :: !Int, |
1804 | 20 |
sendChan :: Chan [String], |
21 |
clientHandle :: Handle, |
|
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 | 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 | 27 |
clientProto :: !Word16, |
28 |
roomID :: !Int, |
|
29 |
pingsQueue :: !Word, |
|
1804 | 30 |
isMaster :: Bool, |
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, |
2403 | 33 |
clientClan :: String, |
2245
c011aecc95e5
unc0rr's patch from issue #144 - prevent spectators from ruining the game
nemo
parents:
2173
diff
changeset
|
34 |
teamsInGame :: Word |
1804 | 35 |
} |
36 |
||
37 |
instance Show ClientInfo where |
|
2352 | 38 |
show ci = show (clientUID ci) |
2004 | 39 |
++ " nick: " ++ (nick ci) |
40 |
++ " host: " ++ (host ci) |
|
1804 | 41 |
|
42 |
instance Eq ClientInfo where |
|
2352 | 43 |
(==) = (==) `on` clientHandle |
1804 | 44 |
|
45 |
data HedgehogInfo = |
|
46 |
HedgehogInfo String String |
|
47 |
||
48 |
data TeamInfo = |
|
49 |
TeamInfo |
|
50 |
{ |
|
2403 | 51 |
teamownerId :: !Int, |
1804 | 52 |
teamowner :: String, |
53 |
teamname :: String, |
|
54 |
teamcolor :: String, |
|
55 |
teamgrave :: String, |
|
56 |
teamfort :: String, |
|
57 |
teamvoicepack :: String, |
|
58 |
difficulty :: Int, |
|
59 |
hhnum :: Int, |
|
60 |
hedgehogs :: [HedgehogInfo] |
|
61 |
} |
|
62 |
||
63 |
data RoomInfo = |
|
64 |
RoomInfo |
|
65 |
{ |
|
2004 | 66 |
roomUID :: !Int, |
2408 | 67 |
masterID :: !Int, |
1804 | 68 |
name :: String, |
69 |
password :: String, |
|
70 |
roomProto :: Word16, |
|
71 |
teams :: [TeamInfo], |
|
72 |
gameinprogress :: Bool, |
|
73 |
playersIn :: !Int, |
|
2004 | 74 |
readyPlayers :: !Int, |
1804 | 75 |
playersIDs :: IntSet.IntSet, |
76 |
isRestrictedJoins :: Bool, |
|
77 |
isRestrictedTeams :: Bool, |
|
78 |
roundMsgs :: Seq String, |
|
79 |
leftTeams :: [String], |
|
80 |
teamsAtStart :: [TeamInfo], |
|
81 |
params :: Map.Map String [String] |
|
82 |
} |
|
83 |
||
84 |
instance Show RoomInfo where |
|
2352 | 85 |
show ri = show (roomUID ri) |
86 |
++ ", players ids: " ++ show (IntSet.size $ playersIDs ri) |
|
87 |
++ ", players: " ++ show (playersIn ri) |
|
88 |
++ ", ready: " ++ show (readyPlayers ri) |
|
1804 | 89 |
|
90 |
instance Eq RoomInfo where |
|
2352 | 91 |
(==) = (==) `on` roomUID |
1804 | 92 |
|
93 |
newRoom = ( |
|
94 |
RoomInfo |
|
95 |
0 |
|
2408 | 96 |
0 |
1804 | 97 |
"" |
98 |
"" |
|
99 |
0 |
|
100 |
[] |
|
101 |
False |
|
102 |
0 |
|
103 |
0 |
|
104 |
IntSet.empty |
|
105 |
False |
|
106 |
False |
|
107 |
Data.Sequence.empty |
|
108 |
[] |
|
109 |
[] |
|
110 |
(Map.singleton "MAP" ["+rnd+"]) |
|
111 |
) |
|
112 |
||
113 |
data StatisticsInfo = |
|
114 |
StatisticsInfo |
|
115 |
{ |
|
116 |
playersNumber :: Int, |
|
117 |
roomsNumber :: Int |
|
118 |
} |
|
119 |
||
120 |
data ServerInfo = |
|
121 |
ServerInfo |
|
122 |
{ |
|
123 |
isDedicated :: Bool, |
|
124 |
serverMessage :: String, |
|
1953 | 125 |
serverMessageForOldVersions :: String, |
1804 | 126 |
listenPort :: PortNumber, |
127 |
nextRoomID :: Int, |
|
1832 | 128 |
dbHost :: String, |
129 |
dbLogin :: String, |
|
130 |
dbPassword :: String, |
|
1926
cb46fbdcaa41
Add simple DoS protection mechanism (although better than previous server had)
unc0rr
parents:
1921
diff
changeset
|
131 |
lastLogins :: [(String, UTCTime)], |
1833 | 132 |
stats :: TMVar StatisticsInfo, |
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1833
diff
changeset
|
133 |
coreChan :: Chan CoreMessage, |
1833 | 134 |
dbQueries :: Chan DBQuery |
1804 | 135 |
} |
136 |
||
137 |
instance Show ServerInfo where |
|
2004 | 138 |
show si = "Server Info" |
1804 | 139 |
|
140 |
newServerInfo = ( |
|
141 |
ServerInfo |
|
142 |
True |
|
143 |
"<h2><p align=center><a href=\"http://www.hedgewars.org/\">http://www.hedgewars.org/</a></p></h2>" |
|
2551 | 144 |
"<font color=yellow><h3>Hedgewars 0.9.12 is out! Please, update.</h3><p align=center><a href=http://hedgewars.org/download.html>Download page here</a></font>" |
1804 | 145 |
46631 |
146 |
0 |
|
1832 | 147 |
"" |
148 |
"" |
|
149 |
"" |
|
1926
cb46fbdcaa41
Add simple DoS protection mechanism (although better than previous server had)
unc0rr
parents:
1921
diff
changeset
|
150 |
[] |
1804 | 151 |
) |
152 |
||
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1833
diff
changeset
|
153 |
data AccountInfo = |
1847
2178c0fc838c
Set admin flag and send admin notification to users with rid equal to 3
unc0rr
parents:
1841
diff
changeset
|
154 |
HasAccount String Bool |
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1833
diff
changeset
|
155 |
| Guest |
1921 | 156 |
| Admin |
2116
dec7ead2d178
Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents:
2104
diff
changeset
|
157 |
deriving (Show, Read) |
dec7ead2d178
Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents:
2104
diff
changeset
|
158 |
|
dec7ead2d178
Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents:
2104
diff
changeset
|
159 |
data DBQuery = |
dec7ead2d178
Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents:
2104
diff
changeset
|
160 |
CheckAccount Int String String |
2155
d897222d3339
Implement ability for server admin to clear accounts cache
unc0rr
parents:
2116
diff
changeset
|
161 |
| ClearCache |
2172 | 162 |
| SendStats Int Int |
2116
dec7ead2d178
Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents:
2104
diff
changeset
|
163 |
deriving (Show, Read) |
1839
5dd4cb7fd7e5
Server now send ASKPASSWORD command to frontend when user has web account
unc0rr
parents:
1833
diff
changeset
|
164 |
|
1804 | 165 |
data CoreMessage = |
166 |
Accept ClientInfo |
|
167 |
| ClientMessage (Int, [String]) |
|
2116
dec7ead2d178
Bring back authentication to official server, now using separate process to perform database interaction
unc0rr
parents:
2104
diff
changeset
|
168 |
| ClientAccountInfo (Int, AccountInfo) |
2173 | 169 |
| TimerAction Int |
1804 | 170 |
|
171 |
type Clients = IntMap.IntMap ClientInfo |
|
172 |
type Rooms = IntMap.IntMap RoomInfo |
|
173 |
||
174 |
--type ClientsTransform = [ClientInfo] -> [ClientInfo] |
|
175 |
--type RoomsTransform = [RoomInfo] -> [RoomInfo] |
|
176 |
--type HandlesSelector = ClientInfo -> [ClientInfo] -> [RoomInfo] -> [ClientInfo] |
|
177 |
--type Answer = ServerInfo -> (HandlesSelector, [String]) |
|
178 |
||
179 |
type ClientsSelector = Clients -> Rooms -> [Int] |