1{-
2 * Hedgewars, a free turn based strategy game
3 * Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com>
4 *
5 * This program is free software; you can redistribute it and/or modify
6 * it under the terms of the GNU General Public License as published by
7 * the Free Software Foundation; version 2 of the License
8 *
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12 * GNU General Public License for more details.
13 *
14 * You should have received a copy of the GNU General Public License
15 * along with this program; if not, write to the Free Software
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
17 \-}
18
19{-# LANGUAGE CPP, OverloadedStrings, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
20module CoreTypes where
21
22import Control.Concurrent
23import Data.Word
24import qualified Data.Map as Map
25import Data.Time
26import Network
27import Data.Function
28import Data.ByteString.Char8 as B
29import Data.Unique
30import Control.Exception
31import Data.Typeable
32import Data.TConfig
33import Control.DeepSeq
34-----------------------
35import RoomsAndClients
36
37#if __GLASGOW_HASKELL__ < 706
38instance NFData B.ByteString
39#endif
40
41instance NFData (Chan a) where rnf a  = a `seq` ()
42
43instance NFData Action where
44    rnf (AnswerClients chans msg) = chans `deepseq` msg `deepseq` ()
45    rnf a = a `seq` ()
46
47data Action =
48    AnswerClients ![ClientChan] ![B.ByteString]
49    | SendServerMessage
50    | SendServerVars
51    | MoveToRoom RoomIndex
52    | MoveToLobby B.ByteString
53    | RemoveTeam B.ByteString
54    | SendTeamRemovalMessage B.ByteString
55    | RemoveRoom
56    | FinishGame
57    | UnreadyRoomClients
58    | JoinLobby
59    | ProtocolError B.ByteString
60    | Warning B.ByteString
61    | NoticeMessage Notice
62    | ByeClient B.ByteString
63    | KickClient ClientIndex
64    | KickRoomClient ClientIndex
65    | BanClient NominalDiffTime B.ByteString ClientIndex
66    | BanIP B.ByteString NominalDiffTime B.ByteString
67    | BanNick B.ByteString NominalDiffTime B.ByteString
68    | BanList
69    | Unban B.ByteString
70    | ChangeMaster (Maybe ClientIndex)
71    | RemoveClientTeams
72    | ModifyClient (ClientInfo -> ClientInfo)
73    | ModifyClient2 ClientIndex (ClientInfo -> ClientInfo)
74    | ModifyRoomClients (ClientInfo -> ClientInfo)
75    | ModifyRoom (RoomInfo -> RoomInfo)
76    | ModifyServerInfo (ServerInfo -> ServerInfo)
77    | AddRoom B.ByteString B.ByteString
78    | SendUpdateOnThisRoom
79    | CheckRegistered
80    | ClearAccountsCache
81    | ProcessAccountInfo AccountInfo
82    | AddClient ClientInfo
83    | DeleteClient ClientIndex
84    | PingAll
85    | StatsAction
86    | RestartServer
87    | AddNick2Bans B.ByteString B.ByteString UTCTime
88    | AddIP2Bans B.ByteString B.ByteString UTCTime
89    | CheckBanned Bool
90    | SaveReplay
91    | Stats
92    | CheckRecord
93    | CheckFailed B.ByteString
94    | CheckSuccess [B.ByteString]
95    | Random [ClientChan] [B.ByteString]
96    | LoadGhost B.ByteString
97    | QueryReplay B.ByteString
98    | ShowReplay B.ByteString
99    | Cleanup
100    | RegisterEvent Event
101    | SaveRoom B.ByteString
102    | LoadRoom B.ByteString
103    | ReactCmd [B.ByteString]
104    | CheckVotes
105    | SetRandomSeed
106    | ShowRegisteredOnlyState [ClientChan]
107
108
109data Event = LobbyChatMessage
110           | EngineMessage
111           | RoomJoin
112           | RoomNameUpdate
113
114type EventsInfo = [(Int, UTCTime)]
115
116newEventsInfo :: EventsInfo
117newEventsInfo = []
118
119type ClientChan = Chan [B.ByteString]
120
121data CheckInfo =
122    CheckInfo
123    {
124        recordFileName :: String,
125        recordTeams :: [TeamInfo],
126        details :: Maybe GameDetails
127    }
128
129data ClientInfo =
130    ClientInfo
131    {
132        clUID :: !Unique,
133        sendChan :: !ClientChan,
134        clientSocket :: !Socket,
135        host :: !B.ByteString,
136        connectTime :: !UTCTime,
137        nick :: !B.ByteString,
138        webPassword :: !B.ByteString,
139        serverSalt :: !B.ByteString,
140        logonPassed :: !Bool,
141        isVisible :: !Bool,
142        clientProto :: !Word16,
143        pingsQueue :: !Word,
144        isMaster :: !Bool,
145        isReady :: !Bool,
146        isInGame :: !Bool,
147        isAdministrator :: !Bool,
148        hasSuperPower :: !Bool,
149        isChecker :: !Bool,
150        isContributor :: !Bool,
151        isKickedFromServer :: !Bool,
152        isJoinedMidGame :: !Bool,
153        hasAskedList :: !Bool,
154        clientClan :: !(Maybe B.ByteString),
155        checkInfo :: !(Maybe CheckInfo),
156        eiLobbyChat,
157        eiEM,
158        eiJoin :: !EventsInfo,
159        teamsInGame :: !Word,
160        teamIndexes :: ![Word8],
161        pendingActions :: ![Action]
162    }
163
164instance Eq ClientInfo where
165    (==) = (==) `on` clientSocket
166
167data HedgehogInfo =
168    HedgehogInfo B.ByteString B.ByteString
169    deriving (Show, Read)
170
171data TeamInfo =
172    TeamInfo
173    {
174        teamowner :: !B.ByteString,
175        teamname :: !B.ByteString,
176        teamcolor :: !B.ByteString,
177        teamgrave :: !B.ByteString,
178        teamfort :: !B.ByteString,
179        teamvoicepack :: !B.ByteString,
180        teamflag :: !B.ByteString,
181        isOwnerRegistered :: !Bool,
182        difficulty :: !Int,
183        hhnum :: !Int,
184        hedgehogs :: ![HedgehogInfo]
185    }
186    deriving (Show, Read)
187
188instance Eq TeamInfo where
189    (==) = (==) `on` teamname
190
191data GameInfo =
192    GameInfo
193    {
194        roundMsgs :: [B.ByteString],
195        lastFilteredTimedMsg :: Maybe B.ByteString,
196        leftTeams :: [B.ByteString],
197        rejoinedTeams :: [B.ByteString], -- for 0.9.21 frontend workaround
198        teamsAtStart :: [TeamInfo],
199        teamsInGameNumber :: Int,
200        allPlayersHaveRegisteredAccounts :: !Bool,
201        giMapParams :: Map.Map B.ByteString B.ByteString,
202        giParams :: Map.Map B.ByteString [B.ByteString],
203        isPaused :: Bool
204    } deriving (Show, Read)
205
206newGameInfo :: [TeamInfo]
207                -> Int
208                -> Bool
209                -> Map.Map ByteString ByteString
210                -> Map.Map ByteString [ByteString]
211                -> Bool
212                -> GameInfo
213newGameInfo =
214    GameInfo
215        []
216        Nothing
217        []
218        []
219
220
221data RoomInfo =
222    RoomInfo
223    {
224        masterID :: !(Maybe ClientIndex),
225        name :: !B.ByteString,
226        password :: !B.ByteString,
227        roomProto :: !Word16,
228        teams :: ![TeamInfo],
229        gameInfo :: !(Maybe GameInfo),
230        playersIn :: !Int,
231        readyPlayers :: !Int,
232        isRestrictedJoins :: !Bool,
233        isRestrictedTeams :: !Bool,
234        isRegisteredOnly :: !Bool,
235        isSpecial :: !Bool,
236        defaultHedgehogsNumber :: !Int,
237        teamsNumberLimit :: !Int,
238        greeting :: !B.ByteString,
239        voting :: !(Maybe Voting),
240        roomBansList :: ![B.ByteString],
241        mapParams :: !(Map.Map B.ByteString B.ByteString),
242        params :: !(Map.Map B.ByteString [B.ByteString]),
243        roomSaves :: !(Map.Map B.ByteString (B.ByteString, Map.Map B.ByteString B.ByteString, Map.Map B.ByteString [B.ByteString]))
244    }
245
246newRoom :: RoomInfo
247newRoom =
248    RoomInfo
249        Nothing
250        ""
251        ""
252        0
253        []
254        Nothing
255        0
256        0
257        False
258        False
259        False
260        False
261        4
262        8
263        ""
264        Nothing
265        []
266        (
267            Map.fromList $ Prelude.zip
268                ["FEATURE_SIZE", "MAP", "MAPGEN", "MAZE_SIZE", "SEED", "TEMPLATE"]
269                ["12", "+rnd+", "0", "0", "seed", "0"]
270        )
271        (
272            Map.fromList $ Prelude.zip
273                ["AMMO", "SCHEME", "SCRIPT", "THEME"]
274                [["Default"], ["Default"], ["Normal"], ["avematan"]]
275        )
276        Map.empty
277
278
279data StatisticsInfo =
280    StatisticsInfo
281    {
282        playersNumber :: Int,
283        roomsNumber :: Int
284    }
285
286data ServerInfo =
287    ServerInfo
288    {
289        isDedicated :: Bool,
290        isRegisteredUsersOnly :: Bool,
291        serverMessage :: B.ByteString,
292        serverMessageForOldVersions :: B.ByteString,
293        latestReleaseVersion :: Word16,
294        earliestCompatibleVersion :: Word16,
295        listenPort :: PortNumber,
296        dbHost :: B.ByteString,
297        dbName :: B.ByteString,
298        dbLogin :: B.ByteString,
299        dbPassword :: B.ByteString,
300        bans :: [BanInfo],
301        shutdownPending :: Bool,
302        runArgs :: [String],
303        coreChan :: Chan CoreMessage,
304        dbQueries :: Chan DBQuery,
305        serverSocket :: Maybe Socket,
306        serverConfig :: Maybe Conf
307    }
308
309
310newServerInfo :: Chan CoreMessage -> Chan DBQuery -> Maybe Socket -> Maybe Conf -> ServerInfo
311newServerInfo =
312    ServerInfo
313        True
314        False
315        "<h2><p align=center><a href=\"https://www.hedgewars.org/\">https://www.hedgewars.org/</a></p></h2>"
316        "<font color=yellow><h3 align=center>Hedgewars 1.0.0 is out! Please update.</h3><p align=center><a href=https://hedgewars.org/download.html>Download page here</a></font>"
317        59 -- latestReleaseVersion
318        41 -- earliestCompatibleVersion
319        46631
320        ""
321        ""
322        ""
323        ""
324        []
325        False
326        []
327
328data Voting = Voting {
329        voteTTL :: Int,
330        entitledToVote :: [Unique],
331        votes :: [(Unique, Bool)],
332        voteType :: VoteType
333    }
334
335
336data VoteType = VoteKick B.ByteString
337              | VoteMap B.ByteString
338              | VotePause
339              | VoteNewSeed
340              | VoteHedgehogsPerTeam Int
341
342
343newVoting :: VoteType -> Voting
344newVoting = Voting 2 [] []
345
346
347data AccountInfo =
348    HasAccount B.ByteString Bool Bool
349    | Guest
350    | Admin
351    | ReplayName B.ByteString
352    deriving (Show, Read)
353
354data DBQuery =
355    CheckAccount ClientIndex Int B.ByteString B.ByteString
356    | ClearCache
357    | SendStats Int Int
358    | StoreAchievements Word16 B.ByteString [(B.ByteString, B.ByteString)] GameDetails [B.ByteString]
359    | GetReplayName ClientIndex Int B.ByteString
360    deriving (Show, Read)
361
362data GameDetails =
363    GameDetails {
364        gameScript :: B.ByteString
365        , infRope
366        , isVamp
367        , infAttacks :: Bool
368    } deriving (Show, Read)
369
370instance NFData GameDetails where
371    rnf (GameDetails a b c d) = a `deepseq` b `deepseq` c `deepseq` d `deepseq` ()
372
373data CoreMessage =
374    Accept ClientInfo
375    | ClientMessage (ClientIndex, [B.ByteString])
376    | ClientAccountInfo ClientIndex Int AccountInfo
377    | TimerAction Int
378    | Remove ClientIndex
379
380type MRnC = MRoomsAndClients RoomInfo ClientInfo
381type IRnC = IRoomsAndClients RoomInfo ClientInfo
382
383data Notice =
384    NickAlreadyInUse
385    | AdminLeft
386    | WrongPassword
387    deriving Enum
388
389data ShutdownException =
390    ShutdownException
391     deriving (Show, Typeable)
392
393instance Exception ShutdownException
394
395data ShutdownThreadException = ShutdownThreadException String
396     deriving Typeable
397
398instance Show ShutdownThreadException where
399    show (ShutdownThreadException s) = s
400instance Exception ShutdownThreadException
401
402data BanInfo =
403    BanByIP B.ByteString B.ByteString UTCTime
404    | BanByNick B.ByteString B.ByteString UTCTime
405    deriving (Show, Read)
406