module Actions where

import Control.Concurrent.STM

import Control.Concurrent.Chan

import qualified Data.IntSet as IntSet

import qualified Data.Sequence as Seq

import System.Log.Logger

import Monad

import Data.Time

import Maybe

-----------------------------

import CoreTypes

import Utils

data Action =

    | SendServerMessage

    | SendServerVars

    | RoomAddThisClient Int -- roomID

    | RoomRemoveThisClient String

    | RemoveTeam String

    | RemoveRoom

    | UnreadyRoomClients

    | MoveToLobby

    | ProtocolError String

    | Warning String

    | ByeClient String

    | KickClient Int -- clID

    | KickRoomClient Int -- clID

    | BanClient String -- nick

    | RemoveClientTeams Int -- clID

    | ModifyClient (ClientInfo -> ClientInfo)

    | ModifyClient2 Int (ClientInfo -> ClientInfo)

    | ModifyRoom (RoomInfo -> RoomInfo)

    | ModifyServerInfo (ServerInfo -> ServerInfo)

    | AddRoom String String

    | CheckRegistered

    | ClearAccountsCache

    | ProcessAccountInfo AccountInfo

    | Dump

    | AddClient ClientInfo

    | PingAll

    | StatsAction

replaceID a (b, c, d, e) = (a, c, d, e)

    writeChan (sendChan $ clients ! clID) ["SERVER_MESSAGE", message serverInfo]

    where

        client = clients ! clID

        message si = if clientProto client < latestReleaseVersion si then

            serverMessageForOldVersions si

            else

            serverMessage si

    writeChan (sendChan $ clients ! clID) ("SERVER_VARS" : vars)

    where

        client = clients ! clID

        vars = [

            "LATEST_PROTO", show $ latestReleaseVersion serverInfo

            ]

    writeChan (sendChan $ clients ! clID) ["ERROR", msg]

    writeChan (sendChan $ clients ! clID) ["WARNING", msg]

    infoM "Clients" (show (clientUID client) ++ " quits: " ++ msg)

    (_, _, newClients, newRooms) <-

            if roomID client /= 0 then

                else

    mapM_ (processAction (clID, serverInfo, newClients, newRooms)) $ answerOthersQuit ++ answerInformRoom

    writeChan (sendChan $ clients ! clID) ["BYE", msg]

    return (

            0,

            serverInfo,

            delete clID newClients,

            adjust (\r -> r{

                    playersIDs = IntSet.delete clID (playersIDs r),

                    playersIn = (playersIn r) - 1,

                    readyPlayers = if isReady client then readyPlayers r - 1 else readyPlayers r

                    }) (roomID $ newClients ! clID) newRooms

            )

    where

        client = clients ! clID

        clientNick = nick client

        answerInformRoom =

            if roomID client /= 0 then

                if not $ Prelude.null msg then

                    [AnswerThisRoom ["LEFT", clientNick, msg]]

                else

                    [AnswerThisRoom ["LEFT", clientNick]]

            else

                []

        answerOthersQuit =

            if logonPassed client then

                if not $ Prelude.null msg then

                    [AnswerAll ["LOBBY:LEFT", clientNick, msg]]

                else

                    [AnswerAll ["LOBBY:LEFT", clientNick]]

            else

                []

    return (clID, serverInfo, clients, adjust func rID rooms)

    where

        rID = roomID $ clients ! clID

    processAction (

        clID,

        serverInfo,

        adjust (\cl -> cl{roomID = rID, teamsInGame = if rID == 0 then teamsInGame cl else 0}) clID clients,

        adjust (\r -> r{playersIDs = IntSet.insert clID (playersIDs r), playersIn = (playersIn r) + 1}) rID $

            adjust (\r -> r{playersIDs = IntSet.delete clID (playersIDs r)}) 0 rooms

        ) joinMsg

    where

        client = clients ! clID

        joinMsg = if rID == 0 then

                AnswerAllOthers ["LOBBY:JOINED", nick client]

            else

                AnswerThisRoom ["JOINED", nick client]

    (_, _, newClients, newRooms) <-

        if roomID client /= 0 then

            if isMaster client then

                if (gameinprogress room) && (playersIn room > 1) then

                    (changeMaster >>= (\state -> foldM processAction state

                        [AnswerOthersInRoom ["LEFT", nick client, msg],

                        AnswerOthersInRoom ["WARNING", "Admin left the room"],

                        RemoveClientTeams clID]))

                else -- not in game

            else -- not master

                foldM

                    processAction

                        [AnswerOthersInRoom ["LEFT", nick client, msg],

                        RemoveClientTeams clID]

        else -- in lobby

    return (

        clID,

        serverInfo,

        adjust resetClientFlags clID newClients,

        adjust removeClientFromRoom rID $ adjust insertClientToRoom 0 newRooms

        )

    where

        rID = roomID client

        client = clients ! clID

        room = rooms ! rID

        resetClientFlags cl = cl{roomID = 0, isMaster = False, isReady = False, teamsInGame = undefined}

        removeClientFromRoom r = r{

                playersIDs = otherPlayersSet,

                playersIn = (playersIn r) - 1,

                readyPlayers = if isReady client then (readyPlayers r) - 1 else readyPlayers r

                }

        insertClientToRoom r = r{playersIDs = IntSet.insert clID (playersIDs r)}

        changeMaster = do

            return (

                clID,

                serverInfo,

                adjust (\cl -> cl{isMaster = True}) newMasterId clients,

                adjust (\r -> r{masterID = newMasterId, name = newRoomName}) rID rooms

                )

        newRoomName = nick newMasterClient

        otherPlayersSet = IntSet.delete clID (playersIDs room)

        newMasterId = IntSet.findMin otherPlayersSet

        newMasterClient = clients ! newMasterId

    let newServerInfo = serverInfo {nextRoomID = newID}

    let room = newRoom{

            roomUID = newID,

            masterID = clID,

            name = roomName,

            password = roomPassword,

            roomProto = (clientProto client)

            }

    processAction (

        clID,

        newServerInfo,

        adjust (\cl -> cl{isMaster = True}) clID clients,

        insert newID room rooms

        ) $ RoomAddThisClient newID

    where

        newID = (nextRoomID serverInfo) - 1

        client = clients ! clID

    return (clID,

        serverInfo,

        Data.IntMap.map (\cl -> if roomID cl == rID then cl{roomID = 0, isMaster = False, isReady = False, teamsInGame = undefined} else cl) clients,

        delete rID $ adjust (\r -> r{playersIDs = IntSet.union (playersIDs room) (playersIDs r)}) 0 rooms

        )

    where

        room = rooms ! rID

        rID = roomID client

        client = clients ! clID

    return (clID,

        serverInfo,

        Data.IntMap.map (\cl -> if roomID cl == rID then cl{isReady = False} else cl) clients,

        adjust (\r -> r{readyPlayers = 0}) rID rooms)

    where

        room = rooms ! rID

        rID = roomID client

        client = clients ! clID

        roomPlayers = Prelude.map (nick . (clients !)) roomPlayersIDs

        roomPlayersIDs = IntSet.elems $ playersIDs room

    newRooms <- if not $ gameinprogress room then

            do

            return $

                adjust (\r -> r{teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r}) rID rooms

        else

            do

            return $

                adjust (\r -> r{

                teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r,

                leftTeams = teamName : leftTeams r,

                roundMsgs = roundMsgs r Seq.|> rmTeamMsg

                }) rID rooms

    return (clID, serverInfo, clients, newRooms)

    where

        room = rooms ! rID

        rID = roomID client

        client = clients ! clID

        rmTeamMsg = toEngineMsg $ 'F' : teamName

    writeChan (dbQueries serverInfo) $ CheckAccount (clientUID client) (nick client) (host client)

    where

        client = clients ! clID

    writeChan (dbQueries serverInfo) ClearCache

    where

        client = clients ! clID

    writeChan (sendChan $ clients ! clID) ["DUMP", show serverInfo, showTree clients, showTree rooms]

    case info of

        HasAccount passwd isAdmin -> do

            infoM "Clients" $ show clID ++ " has account"

            writeChan (sendChan $ clients ! clID) ["ASKPASSWORD"]

        Guest -> do

            infoM "Clients" $ show clID ++ " is guest"

        Admin -> do

            infoM "Clients" $ show clID ++ " is admin"

        (RoomAddThisClient 0)

        : answerLobbyNicks

        ++ [SendServerMessage]

        -- ++ (answerServerMessage client clients)

    where

        lobbyNicks = Prelude.map nick $ Prelude.filter logonPassed $ elems clients

        answerLobbyNicks = [AnswerThisClient ("LOBBY:JOINED": lobbyNicks) | not $ Prelude.null lobbyNicks]

    writeChan (sendChan $ clients ! kickID) ["KICKED"]

    liftM2 replaceID (return clID) $

    where

        client = clients ! teamsClID

        room = rooms ! (roomID client)

        teamsToRemove = Prelude.filter (\t -> teamowner t == nick client) $ teams room

        removeTeamsActions = Prelude.map (RemoveTeam . teamname) teamsToRemove

    let updatedClients = insert (clientUID client) client clients

    infoM "Clients" (show (clientUID client) ++ ": New client. Time: " ++ show (connectTime client))

    writeChan (sendChan client) ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"]

    let newLogins = takeWhile (\(_ , time) -> (connectTime client) `diffUTCTime` time <= 11) $ lastLogins serverInfo

        processAction (clID, serverInfo{lastLogins = newLogins}, updatedClients, rooms) $ ByeClient "Reconnected too fast"

        else

        return (clID, serverInfo{lastLogins = (host client, connectTime client) : newLogins}, updatedClients, rooms)

    processAction (clID,

        serverInfo,

        Data.IntMap.map (\cl -> cl{pingsQueue = pingsQueue cl + 1}) newClients,

        newRooms) $ AnswerAll ["PING"]

    where

            if pingsQueue client > 0 then

                else

    writeChan (dbQueries serverInfo) $ SendStats (size clients) (size rooms - 1)