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