module ServerCore where

import Network
import Control.Concurrent
import Control.Concurrent.STM
import Control.Concurrent.Chan
import Control.Monad
import qualified Data.IntMap as IntMap
import System.Log.Logger
--------------------------------------
import CoreTypes
import NetRoutines
import Utils
import HWProtoCore
import Actions
import OfficialServer.DBInteraction


timerLoop :: Chan CoreMessage -> IO()
timerLoop messagesChan = forever $ do
	threadDelay (30 * 10^6) -- 30 seconds
	writeChan messagesChan TimerAction

firstAway (_, a, b, c) = (a, b, c)

reactCmd :: ServerInfo -> Int -> [String] -> Clients -> Rooms -> IO (ServerInfo, Clients, Rooms)
reactCmd serverInfo clID cmd clients rooms =
	liftM firstAway $ foldM processAction (clID, serverInfo, clients, rooms) $ handleCmd clID clients rooms cmd

mainLoop :: ServerInfo -> Clients -> Rooms -> IO ()
mainLoop serverInfo clients rooms = do
	r <- readChan $ coreChan serverInfo
	
	(newServerInfo, mClients, mRooms) <-
		case r of
			Accept ci -> do
				liftM firstAway $ processAction
					(clientUID ci, serverInfo, clients, rooms) (AddClient ci)

			ClientMessage (clID, cmd) -> do
				debugM "Clients" $ (show clID) ++ ": " ++ (show cmd)
				if clID `IntMap.member` clients then
					reactCmd serverInfo clID cmd clients rooms
					else
					do
					debugM "Clients" "Message from dead client"
					return (serverInfo, clients, rooms)

			ClientAccountInfo (clID, info) ->
				if clID `IntMap.member` clients then
					liftM firstAway $ processAction
						(clID, serverInfo, clients, rooms)
						(ProcessAccountInfo info)
					else
					do
					debugM "Clients" "Got info for dead client"
					return (serverInfo, clients, rooms)

			TimerAction ->
				liftM firstAway $
					foldM processAction (0, serverInfo, clients, rooms)
						[PingAll, StatsAction]


	{-			let hadRooms = (not $ null rooms) && (null mrooms)
					in unless ((not $ isDedicated serverInfo) && ((null clientsIn) || hadRooms)) $
						mainLoop serverInfo acceptChan messagesChan clientsIn mrooms -}

	mainLoop newServerInfo mClients mRooms

startServer :: ServerInfo -> Socket -> IO ()
startServer serverInfo serverSocket = do
	putStrLn $ "Listening on port " ++ show (listenPort serverInfo)

	forkIO $
		acceptLoop
			serverSocket
			(coreChan serverInfo)
			0

	return ()
	
	forkIO $ timerLoop $ coreChan serverInfo

	startDBConnection $ serverInfo

	mainLoop serverInfo IntMap.empty (IntMap.singleton 0 newRoom)