netserver/Miscutils.hs
author unc0rr
Thu, 08 Jan 2009 22:01:09 +0000
changeset 1618 2b9cadc232ab
parent 1617 30170c63a9dd
child 1646 19b3784ac9d2
permissions -rw-r--r--
Fix server bugs: - Wrong room destryed notification - Not proper notifying when room master quits - smth else I forgot already

module Miscutils where

import IO
import Control.Concurrent.STM
import Data.Word
import Data.Char
import Data.List
import Maybe (fromJust)
import qualified Data.Map as Map
import Data.Time
import Network

data ClientInfo =
 ClientInfo
	{
		chan :: TChan [String],
		sendChan :: TChan [String],
		handle :: Handle,
		host :: String,
		connectTime :: UTCTime,
		nick :: String,
		protocol :: Word16,
		room :: String,
		isMaster :: Bool,
		isReady :: Bool,
		forceQuit :: Bool,
		partRoom :: Bool
	}

instance Eq ClientInfo where
	a1 == a2 = handle a1 == handle a2

data HedgehogInfo =
	HedgehogInfo String String

data TeamInfo =
	TeamInfo
	{
		teamowner :: String,
		teamname :: String,
		teamcolor :: String,
		teamgrave :: String,
		teamfort :: String,
		difficulty :: Int,
		hhnum :: Int,
		hedgehogs :: [HedgehogInfo]
	}

data RoomInfo =
	RoomInfo
	{
		name :: String,
		password :: String,
		roomProto :: Word16,
		teams :: [TeamInfo],
		gamemap :: String,
		gameinprogress :: Bool,
		playersIn :: Int,
		readyPlayers :: Int,
		isRestrictedJoins :: Bool,
		isRestrictedTeams :: Bool,
		roundMsgs :: [String],
		params :: Map.Map String [String]
	}
createRoom = (
	RoomInfo
		""
		""
		0
		[]
		"+rnd+"
		False
		1
		0
		False
		False
		[]
		Map.empty
	)

data ServerInfo =
	ServerInfo
	{
		isDedicated :: Bool,
		serverMessage :: String,
		listenPort :: PortNumber,
		loginsNumber :: Int,
		lastHourUsers :: [UTCTime]
	}
newServerInfo = (
	ServerInfo
		True
		"<h2><p align=center><a href=\"http://www.hedgewars.org/\">http://www.hedgewars.org/</a></p></h2>"
		46631
		0
		[]
	)

type ClientsTransform = [ClientInfo] -> [ClientInfo]
type RoomsTransform = [RoomInfo] -> [RoomInfo]
type HandlesSelector = ClientInfo -> [ClientInfo] -> [RoomInfo] -> [ClientInfo]
type Answer = ServerInfo -> (HandlesSelector, [String])
type CmdHandler = ClientInfo -> [ClientInfo] -> [RoomInfo] -> [String] -> (ClientsTransform, RoomsTransform, [Answer])


roomByName :: String -> [RoomInfo] -> RoomInfo
roomByName roomName rooms = fromJust $ find (\room -> roomName == name room) rooms

tselect :: [ClientInfo] -> STM ([String], ClientInfo)
tselect = foldl orElse retry . map (\ci -> (flip (,) ci) `fmap` readTChan (chan ci))

maybeRead :: Read a => String -> Maybe a
maybeRead s = case reads s of
	[(x, rest)] | all isSpace rest -> Just x
	_         -> Nothing

deleteBy2t :: (a -> b -> Bool) -> b -> [a] -> [a]
deleteBy2t _  _ [] = []
deleteBy2t eq x (y:ys) = if y `eq` x then ys else y : deleteBy2t eq x ys

deleteFirstsBy2t :: (a -> b -> Bool) -> [a] -> [b] -> [a]
deleteFirstsBy2t eq =  foldl (flip (deleteBy2t eq))

--clientByHandle :: Handle -> [ClientInfo] -> Maybe ClientInfo
--clientByHandle chandle clients = find (\c -> handle c == chandle) clients

sameRoom :: HandlesSelector
sameRoom client clients rooms = filter (\ci -> room ci == room client) clients

sameProtoLobbyClients :: HandlesSelector
sameProtoLobbyClients client clients rooms = filter (\ci -> room ci == [] && protocol ci == protocol client) clients

otherLobbyClients :: HandlesSelector
otherLobbyClients client clients rooms = filter (\ci -> room ci == []) clients

noRoomSameProto :: HandlesSelector
noRoomSameProto client clients _ = filter (null . room) $ filter (\ci -> protocol client == protocol ci) clients

othersInRoom :: HandlesSelector
othersInRoom client clients rooms = filter (client /=) $ filter (\ci -> room ci == room client) clients

fromRoom :: String -> HandlesSelector
fromRoom roomName _ clients _ = filter (\ci -> room ci == roomName) clients

allClients :: HandlesSelector
allClients _ clients _ = clients

clientOnly :: HandlesSelector
clientOnly client _ _ = [client]

noChangeClients :: ClientsTransform
noChangeClients a = a

modifyClient :: ClientInfo -> ClientsTransform
modifyClient _ [] = error "modifyClient: no such client"
modifyClient client (cl:cls) =
	if cl == client then
		client : cls
	else
		cl : (modifyClient client cls)

modifyRoomClients :: RoomInfo -> (ClientInfo -> ClientInfo) -> ClientsTransform
modifyRoomClients clientsroom clientMod clients = map (\c -> if name clientsroom == room c then clientMod c else c) clients

noChangeRooms :: RoomsTransform
noChangeRooms a = a

addRoom :: RoomInfo -> RoomsTransform
addRoom room rooms = room:rooms

removeRoom :: String -> RoomsTransform
removeRoom roomname rooms = filter (\rm -> roomname /= name rm) rooms

modifyRoom :: RoomInfo -> RoomsTransform
modifyRoom _ [] = error "changeRoomConfig: no such room"
modifyRoom room (rm:rms) =
	if name room == name rm then
		room : rms
	else
		rm : modifyRoom room rms

modifyTeam :: RoomInfo -> TeamInfo -> RoomInfo
modifyTeam room team = room{teams = replaceTeam team $ teams room}
	where
	replaceTeam _ [] = error "modifyTeam: no such team"
	replaceTeam team (t:teams) =
		if teamname team == teamname t then
			team : teams
		else
			t : replaceTeam team teams

proto2ver :: Word16 -> String
proto2ver 17 = "0.9.7-dev"
proto2ver 19 = "0.9.7"
proto2ver 20 = "0.9.8-dev"
proto2ver 21 = "0.9.8"
proto2ver 22 = "0.9.9-dev"
proto2ver _ = "Unknown"