12 import Network |
12 import Network |
13 import Data.Function |
13 import Data.Function |
14 |
14 |
15 |
15 |
16 data ClientInfo = |
16 data ClientInfo = |
17 ClientInfo |
17 ClientInfo |
18 { |
18 { |
19 clientUID :: !Int, |
19 clientUID :: !Int, |
20 sendChan :: Chan [String], |
20 sendChan :: Chan [String], |
21 clientHandle :: Handle, |
21 clientHandle :: Handle, |
22 host :: String, |
22 host :: String, |
23 connectTime :: UTCTime, |
23 connectTime :: UTCTime, |
24 nick :: String, |
24 nick :: String, |
25 webPassword :: String, |
25 webPassword :: String, |
26 logonPassed :: Bool, |
26 logonPassed :: Bool, |
27 clientProto :: !Word16, |
27 clientProto :: !Word16, |
28 roomID :: !Int, |
28 roomID :: !Int, |
29 pingsQueue :: !Word, |
29 pingsQueue :: !Word, |
30 isMaster :: Bool, |
30 isMaster :: Bool, |
31 isReady :: Bool, |
31 isReady :: Bool, |
32 isAdministrator :: Bool, |
32 isAdministrator :: Bool, |
33 clientClan :: String, |
33 clientClan :: String, |
34 teamsInGame :: Word |
34 teamsInGame :: Word |
35 } |
35 } |
36 |
36 |
37 instance Show ClientInfo where |
37 instance Show ClientInfo where |
38 show ci = show (clientUID ci) |
38 show ci = show (clientUID ci) |
39 ++ " nick: " ++ (nick ci) |
39 ++ " nick: " ++ (nick ci) |
40 ++ " host: " ++ (host ci) |
40 ++ " host: " ++ (host ci) |
41 |
41 |
42 instance Eq ClientInfo where |
42 instance Eq ClientInfo where |
43 (==) = (==) `on` clientHandle |
43 (==) = (==) `on` clientHandle |
44 |
44 |
45 data HedgehogInfo = |
45 data HedgehogInfo = |
46 HedgehogInfo String String |
46 HedgehogInfo String String |
47 |
47 |
48 data TeamInfo = |
48 data TeamInfo = |
49 TeamInfo |
49 TeamInfo |
50 { |
50 { |
51 teamownerId :: !Int, |
51 teamownerId :: !Int, |
52 teamowner :: String, |
52 teamowner :: String, |
53 teamname :: String, |
53 teamname :: String, |
54 teamcolor :: String, |
54 teamcolor :: String, |
55 teamgrave :: String, |
55 teamgrave :: String, |
56 teamfort :: String, |
56 teamfort :: String, |
57 teamvoicepack :: String, |
57 teamvoicepack :: String, |
58 teamflag :: String, |
58 teamflag :: String, |
59 difficulty :: Int, |
59 difficulty :: Int, |
60 hhnum :: Int, |
60 hhnum :: Int, |
61 hedgehogs :: [HedgehogInfo] |
61 hedgehogs :: [HedgehogInfo] |
62 } |
62 } |
63 |
63 |
64 data RoomInfo = |
64 data RoomInfo = |
65 RoomInfo |
65 RoomInfo |
66 { |
66 { |
67 roomUID :: !Int, |
67 roomUID :: !Int, |
68 masterID :: !Int, |
68 masterID :: !Int, |
69 name :: String, |
69 name :: String, |
70 password :: String, |
70 password :: String, |
71 roomProto :: Word16, |
71 roomProto :: Word16, |
72 teams :: [TeamInfo], |
72 teams :: [TeamInfo], |
73 gameinprogress :: Bool, |
73 gameinprogress :: Bool, |
74 playersIn :: !Int, |
74 playersIn :: !Int, |
75 readyPlayers :: !Int, |
75 readyPlayers :: !Int, |
76 playersIDs :: IntSet.IntSet, |
76 playersIDs :: IntSet.IntSet, |
77 isRestrictedJoins :: Bool, |
77 isRestrictedJoins :: Bool, |
78 isRestrictedTeams :: Bool, |
78 isRestrictedTeams :: Bool, |
79 roundMsgs :: Seq String, |
79 roundMsgs :: Seq String, |
80 leftTeams :: [String], |
80 leftTeams :: [String], |
81 teamsAtStart :: [TeamInfo], |
81 teamsAtStart :: [TeamInfo], |
82 params :: Map.Map String [String] |
82 params :: Map.Map String [String] |
83 } |
83 } |
84 |
84 |
85 instance Show RoomInfo where |
85 instance Show RoomInfo where |
86 show ri = show (roomUID ri) |
86 show ri = show (roomUID ri) |
87 ++ ", players ids: " ++ show (IntSet.size $ playersIDs ri) |
87 ++ ", players ids: " ++ show (IntSet.size $ playersIDs ri) |
88 ++ ", players: " ++ show (playersIn ri) |
88 ++ ", players: " ++ show (playersIn ri) |
89 ++ ", ready: " ++ show (readyPlayers ri) |
89 ++ ", ready: " ++ show (readyPlayers ri) |
90 |
90 |
91 instance Eq RoomInfo where |
91 instance Eq RoomInfo where |
92 (==) = (==) `on` roomUID |
92 (==) = (==) `on` roomUID |
93 |
93 |
94 newRoom = ( |
94 newRoom = ( |
95 RoomInfo |
95 RoomInfo |
96 0 |
96 0 |
97 0 |
97 0 |
98 "" |
98 "" |
99 "" |
99 "" |
100 0 |
100 0 |
101 [] |
101 [] |
102 False |
102 False |
103 0 |
103 0 |
104 0 |
104 0 |
105 IntSet.empty |
105 IntSet.empty |
106 False |
106 False |
107 False |
107 False |
108 Data.Sequence.empty |
108 Data.Sequence.empty |
109 [] |
109 [] |
110 [] |
110 [] |
111 (Map.singleton "MAP" ["+rnd+"]) |
111 (Map.singleton "MAP" ["+rnd+"]) |
112 ) |
112 ) |
113 |
113 |
114 data StatisticsInfo = |
114 data StatisticsInfo = |
115 StatisticsInfo |
115 StatisticsInfo |
116 { |
116 { |
117 playersNumber :: Int, |
117 playersNumber :: Int, |
118 roomsNumber :: Int |
118 roomsNumber :: Int |
119 } |
119 } |
120 |
120 |
121 data ServerInfo = |
121 data ServerInfo = |
122 ServerInfo |
122 ServerInfo |
123 { |
123 { |
124 isDedicated :: Bool, |
124 isDedicated :: Bool, |
125 serverMessage :: String, |
125 serverMessage :: String, |
126 serverMessageForOldVersions :: String, |
126 serverMessageForOldVersions :: String, |
127 listenPort :: PortNumber, |
127 listenPort :: PortNumber, |
128 nextRoomID :: Int, |
128 nextRoomID :: Int, |
129 dbHost :: String, |
129 dbHost :: String, |
130 dbLogin :: String, |
130 dbLogin :: String, |
131 dbPassword :: String, |
131 dbPassword :: String, |
132 lastLogins :: [(String, UTCTime)], |
132 lastLogins :: [(String, UTCTime)], |
133 stats :: TMVar StatisticsInfo, |
133 stats :: TMVar StatisticsInfo, |
134 coreChan :: Chan CoreMessage, |
134 coreChan :: Chan CoreMessage, |
135 dbQueries :: Chan DBQuery |
135 dbQueries :: Chan DBQuery |
136 } |
136 } |
137 |
137 |
138 instance Show ServerInfo where |
138 instance Show ServerInfo where |
139 show si = "Server Info" |
139 show si = "Server Info" |
140 |
140 |
141 newServerInfo = ( |
141 newServerInfo = ( |
142 ServerInfo |
142 ServerInfo |
143 True |
143 True |
144 "<h2><p align=center><a href=\"http://www.hedgewars.org/\">http://www.hedgewars.org/</a></p></h2>" |
144 "<h2><p align=center><a href=\"http://www.hedgewars.org/\">http://www.hedgewars.org/</a></p></h2>" |
145 "<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>" |
145 "<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>" |
146 46631 |
146 46631 |
147 0 |
147 0 |
148 "" |
148 "" |
149 "" |
149 "" |
150 "" |
150 "" |
151 [] |
151 [] |
152 ) |
152 ) |
153 |
153 |
154 data AccountInfo = |
154 data AccountInfo = |
155 HasAccount String Bool |
155 HasAccount String Bool |
156 | Guest |
156 | Guest |
157 | Admin |
157 | Admin |
158 deriving (Show, Read) |
158 deriving (Show, Read) |
159 |
159 |
160 data DBQuery = |
160 data DBQuery = |
161 CheckAccount Int String String |
161 CheckAccount Int String String |
162 | ClearCache |
162 | ClearCache |
163 | SendStats Int Int |
163 | SendStats Int Int |
164 deriving (Show, Read) |
164 deriving (Show, Read) |
165 |
165 |
166 data CoreMessage = |
166 data CoreMessage = |
167 Accept ClientInfo |
167 Accept ClientInfo |
168 | ClientMessage (Int, [String]) |
168 | ClientMessage (Int, [String]) |
169 | ClientAccountInfo (Int, AccountInfo) |
169 | ClientAccountInfo (Int, AccountInfo) |
170 | TimerAction Int |
170 | TimerAction Int |
171 |
171 |
172 type Clients = IntMap.IntMap ClientInfo |
172 type Clients = IntMap.IntMap ClientInfo |
173 type Rooms = IntMap.IntMap RoomInfo |
173 type Rooms = IntMap.IntMap RoomInfo |
174 |
174 |
175 --type ClientsTransform = [ClientInfo] -> [ClientInfo] |
175 --type ClientsTransform = [ClientInfo] -> [ClientInfo] |