1 {-# LANGUAGE OverloadedStrings #-} |
|
2 module CoreTypes where |
1 module CoreTypes where |
3 |
2 |
4 import System.IO |
3 import System.IO |
5 import Control.Concurrent.Chan |
4 import Control.Concurrent.Chan |
6 import Control.Concurrent.STM |
5 import Control.Concurrent.STM |
7 import Data.Word |
6 import Data.Word |
8 import qualified Data.Map as Map |
7 import qualified Data.Map as Map |
|
8 import qualified Data.IntMap as IntMap |
9 import qualified Data.IntSet as IntSet |
9 import qualified Data.IntSet as IntSet |
10 import Data.Sequence(Seq, empty) |
10 import Data.Sequence(Seq, empty) |
11 import Data.Time |
11 import Data.Time |
12 import Network |
12 import Network |
13 import Data.Function |
13 import Data.Function |
14 import Data.ByteString.Char8 as B |
|
15 |
14 |
16 import RoomsAndClients |
|
17 |
|
18 type ClientChan = Chan [B.ByteString] |
|
19 |
15 |
20 data ClientInfo = |
16 data ClientInfo = |
21 ClientInfo |
17 ClientInfo |
22 { |
18 { |
23 sendChan :: ClientChan, |
19 clientUID :: !Int, |
24 clientSocket :: Socket, |
20 sendChan :: Chan [String], |
25 host :: B.ByteString, |
21 clientHandle :: Handle, |
|
22 host :: String, |
26 connectTime :: UTCTime, |
23 connectTime :: UTCTime, |
27 nick :: B.ByteString, |
24 nick :: String, |
28 webPassword :: B.ByteString, |
25 webPassword :: String, |
29 logonPassed :: Bool, |
26 logonPassed :: Bool, |
30 clientProto :: !Word16, |
27 clientProto :: !Word16, |
31 roomID :: RoomIndex, |
28 roomID :: !Int, |
32 pingsQueue :: !Word, |
29 pingsQueue :: !Word, |
33 isMaster :: Bool, |
30 isMaster :: Bool, |
34 isReady :: !Bool, |
31 isReady :: Bool, |
35 isAdministrator :: Bool, |
32 isAdministrator :: Bool, |
36 clientClan :: B.ByteString, |
33 clientClan :: String, |
37 teamsInGame :: Word |
34 teamsInGame :: Word |
38 } |
35 } |
39 |
36 |
40 instance Show ClientInfo where |
37 instance Show ClientInfo where |
41 show ci = " nick: " ++ (unpack $ nick ci) ++ " host: " ++ (unpack $ host ci) |
38 show ci = show (clientUID ci) |
|
39 ++ " nick: " ++ (nick ci) |
|
40 ++ " host: " ++ (host ci) |
42 |
41 |
43 instance Eq ClientInfo where |
42 instance Eq ClientInfo where |
44 (==) = (==) `on` clientSocket |
43 (==) = (==) `on` clientHandle |
45 |
44 |
46 data HedgehogInfo = |
45 data HedgehogInfo = |
47 HedgehogInfo B.ByteString B.ByteString |
46 HedgehogInfo String String |
48 |
47 |
49 data TeamInfo = |
48 data TeamInfo = |
50 TeamInfo |
49 TeamInfo |
51 { |
50 { |
52 teamownerId :: ClientIndex, |
51 teamownerId :: !Int, |
53 teamowner :: B.ByteString, |
52 teamowner :: String, |
54 teamname :: B.ByteString, |
53 teamname :: String, |
55 teamcolor :: B.ByteString, |
54 teamcolor :: String, |
56 teamgrave :: B.ByteString, |
55 teamgrave :: String, |
57 teamfort :: B.ByteString, |
56 teamfort :: String, |
58 teamvoicepack :: B.ByteString, |
57 teamvoicepack :: String, |
59 teamflag :: B.ByteString, |
58 teamflag :: String, |
60 difficulty :: Int, |
59 difficulty :: Int, |
61 hhnum :: Int, |
60 hhnum :: Int, |
62 hedgehogs :: [HedgehogInfo] |
61 hedgehogs :: [HedgehogInfo] |
63 } |
62 } |
64 |
63 |
65 instance Show TeamInfo where |
64 instance Show TeamInfo where |
66 show ti = "owner: " ++ (unpack $ teamowner ti) |
65 show ti = "owner: " ++ (teamowner ti) |
67 ++ "name: " ++ (unpack $ teamname ti) |
66 ++ "name: " ++ (teamname ti) |
68 ++ "color: " ++ (unpack $ teamcolor ti) |
67 ++ "color: " ++ (teamcolor ti) |
69 |
68 |
70 data RoomInfo = |
69 data RoomInfo = |
71 RoomInfo |
70 RoomInfo |
72 { |
71 { |
73 masterID :: ClientIndex, |
72 roomUID :: !Int, |
74 name :: B.ByteString, |
73 masterID :: !Int, |
75 password :: B.ByteString, |
74 name :: String, |
|
75 password :: String, |
76 roomProto :: Word16, |
76 roomProto :: Word16, |
77 teams :: [TeamInfo], |
77 teams :: [TeamInfo], |
78 gameinprogress :: Bool, |
78 gameinprogress :: Bool, |
79 playersIn :: !Int, |
79 playersIn :: !Int, |
80 readyPlayers :: !Int, |
80 readyPlayers :: !Int, |
|
81 playersIDs :: IntSet.IntSet, |
81 isRestrictedJoins :: Bool, |
82 isRestrictedJoins :: Bool, |
82 isRestrictedTeams :: Bool, |
83 isRestrictedTeams :: Bool, |
83 roundMsgs :: Seq B.ByteString, |
84 roundMsgs :: Seq String, |
84 leftTeams :: [B.ByteString], |
85 leftTeams :: [String], |
85 teamsAtStart :: [TeamInfo], |
86 teamsAtStart :: [TeamInfo], |
86 params :: Map.Map B.ByteString [B.ByteString] |
87 params :: Map.Map String [String] |
87 } |
88 } |
88 |
89 |
89 instance Show RoomInfo where |
90 instance Show RoomInfo where |
90 show ri = ", players: " ++ show (playersIn ri) |
91 show ri = show (roomUID ri) |
|
92 ++ ", players ids: " ++ show (IntSet.size $ playersIDs ri) |
|
93 ++ ", players: " ++ show (playersIn ri) |
91 ++ ", ready: " ++ show (readyPlayers ri) |
94 ++ ", ready: " ++ show (readyPlayers ri) |
92 ++ ", teams: " ++ show (teams ri) |
95 ++ ", teams: " ++ show (teams ri) |
93 |
96 |
94 newRoom :: RoomInfo |
97 instance Eq RoomInfo where |
|
98 (==) = (==) `on` roomUID |
|
99 |
95 newRoom = ( |
100 newRoom = ( |
96 RoomInfo |
101 RoomInfo |
97 undefined |
102 0 |
|
103 0 |
98 "" |
104 "" |
99 "" |
105 "" |
100 0 |
106 0 |
101 [] |
107 [] |
102 False |
108 False |
103 0 |
109 0 |
104 0 |
110 0 |
|
111 IntSet.empty |
105 False |
112 False |
106 False |
113 False |
107 Data.Sequence.empty |
114 Data.Sequence.empty |
108 [] |
115 [] |
109 [] |
116 [] |
119 |
126 |
120 data ServerInfo = |
127 data ServerInfo = |
121 ServerInfo |
128 ServerInfo |
122 { |
129 { |
123 isDedicated :: Bool, |
130 isDedicated :: Bool, |
124 serverMessage :: B.ByteString, |
131 serverMessage :: String, |
125 serverMessageForOldVersions :: B.ByteString, |
132 serverMessageForOldVersions :: String, |
126 latestReleaseVersion :: Word16, |
133 latestReleaseVersion :: Word16, |
127 listenPort :: PortNumber, |
134 listenPort :: PortNumber, |
128 nextRoomID :: Int, |
135 nextRoomID :: Int, |
129 dbHost :: B.ByteString, |
136 dbHost :: String, |
130 dbLogin :: B.ByteString, |
137 dbLogin :: String, |
131 dbPassword :: B.ByteString, |
138 dbPassword :: String, |
132 lastLogins :: [(B.ByteString, UTCTime)], |
139 lastLogins :: [(String, UTCTime)], |
133 stats :: TMVar StatisticsInfo, |
140 stats :: TMVar StatisticsInfo, |
134 coreChan :: Chan CoreMessage, |
141 coreChan :: Chan CoreMessage, |
135 dbQueries :: Chan DBQuery |
142 dbQueries :: Chan DBQuery |
136 } |
143 } |
137 |
144 |
138 instance Show ServerInfo where |
145 instance Show ServerInfo where |
139 show _ = "Server Info" |
146 show si = "Server Info" |
140 |
147 |
141 newServerInfo :: TMVar StatisticsInfo -> Chan CoreMessage -> Chan DBQuery -> ServerInfo |
|
142 newServerInfo = ( |
148 newServerInfo = ( |
143 ServerInfo |
149 ServerInfo |
144 True |
150 True |
145 "<h2><p align=center><a href=\"http://www.hedgewars.org/\">http://www.hedgewars.org/</a></p></h2>" |
151 "<h2><p align=center><a href=\"http://www.hedgewars.org/\">http://www.hedgewars.org/</a></p></h2>" |
146 "<font color=yellow><h3 align=center>Hedgewars 0.9.14.1 is out! Please update.</h3><p align=center><a href=http://hedgewars.org/download.html>Download page here</a></font>" |
152 "<font color=yellow><h3 align=center>Hedgewars 0.9.14.1 is out! Please update.</h3><p align=center><a href=http://hedgewars.org/download.html>Download page here</a></font>" |
152 "" |
158 "" |
153 [] |
159 [] |
154 ) |
160 ) |
155 |
161 |
156 data AccountInfo = |
162 data AccountInfo = |
157 HasAccount B.ByteString Bool |
163 HasAccount String Bool |
158 | Guest |
164 | Guest |
159 | Admin |
165 | Admin |
160 deriving (Show, Read) |
166 deriving (Show, Read) |
161 |
167 |
162 data DBQuery = |
168 data DBQuery = |
163 CheckAccount ClientIndex B.ByteString B.ByteString |
169 CheckAccount Int String String |
164 | ClearCache |
170 | ClearCache |
165 | SendStats Int Int |
171 | SendStats Int Int |
166 deriving (Show, Read) |
172 deriving (Show, Read) |
167 |
173 |
168 data CoreMessage = |
174 data CoreMessage = |
169 Accept ClientInfo |
175 Accept ClientInfo |
170 | ClientMessage (ClientIndex, [B.ByteString]) |
176 | ClientMessage (Int, [String]) |
171 | ClientAccountInfo (ClientIndex, AccountInfo) |
177 | ClientAccountInfo (Int, AccountInfo) |
172 | TimerAction Int |
178 | TimerAction Int |
173 | Remove ClientIndex |
|
174 |
179 |
175 instance Show CoreMessage where |
180 type Clients = IntMap.IntMap ClientInfo |
176 show (Accept _) = "Accept" |
181 type Rooms = IntMap.IntMap RoomInfo |
177 show (ClientMessage _) = "ClientMessage" |
|
178 show (ClientAccountInfo _) = "ClientAccountInfo" |
|
179 show (TimerAction _) = "TimerAction" |
|
180 show (Remove _) = "Remove" |
|
181 |
|
182 type MRnC = MRoomsAndClients RoomInfo ClientInfo |
|
183 type IRnC = IRoomsAndClients RoomInfo ClientInfo |
|
184 |
182 |
|
183 --type ClientsTransform = [ClientInfo] -> [ClientInfo] |
|
184 --type RoomsTransform = [RoomInfo] -> [RoomInfo] |
|
185 --type HandlesSelector = ClientInfo -> [ClientInfo] -> [RoomInfo] -> [ClientInfo] |
|
186 --type Answer = ServerInfo -> (HandlesSelector, [String]) |
|
187 |
|
188 type ClientsSelector = Clients -> Rooms -> [Int] |