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