{-
 * Hedgewars, a free turn based strategy game
 * Copyright (c) 2004-2014 Andrey Korotaev <unC0Rr@gmail.com>
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; version 2 of the License
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 \-}

{-# LANGUAGE CPP, ScopedTypeVariables, OverloadedStrings #-}
module OfficialServer.DBInteraction
(
    startDBConnection
) where

import Prelude hiding (catch);
import Control.Concurrent
import Control.Monad
import Data.List as L
import Data.ByteString.Char8 as B
#if defined(OFFICIAL_SERVER)
import System.Process
import System.IO as SIO
import qualified Control.Exception as Exception
import qualified Data.Map as Map
import Data.Maybe
import Data.Time
import System.Log.Logger
#endif
------------------------
import CoreTypes
#if defined(OFFICIAL_SERVER)
import Utils
#endif

localAddressList :: [B.ByteString]
localAddressList = ["127.0.0.1", "0:0:0:0:0:0:0:1", "0:0:0:0:0:ffff:7f00:1"]

fakeDbConnection :: forall b. ServerInfo -> IO b
fakeDbConnection si = forever $ do
    q <- readChan $ dbQueries si
    case q of
        CheckAccount clId clUid _ clHost ->
            writeChan (coreChan si) $ ClientAccountInfo clId clUid (if clHost `L.elem` localAddressList then Admin else Guest)
        ClearCache -> return ()
        SendStats {} -> return ()

dbConnectionLoop :: ServerInfo -> IO ()

#if defined(OFFICIAL_SERVER)
flushRequests :: ServerInfo -> IO ()
flushRequests si = do
    e <- isEmptyChan $ dbQueries si
    unless e $ do
        q <- readChan $ dbQueries si
        case q of
            CheckAccount clId clUid _ clHost ->
                writeChan (coreChan si) $ ClientAccountInfo clId clUid (if clHost `L.elem` localAddressList then Admin else Guest)
            ClearCache -> return ()
            SendStats {} -> return ()
            GetReplayName {} -> return ()
            StoreAchievements {} -> return ()
        flushRequests si

pipeDbConnectionLoop :: Chan DBQuery -> Chan CoreMessage -> Handle -> Handle -> Map.Map ByteString (UTCTime, AccountInfo) -> Int -> IO (Map.Map ByteString (UTCTime, AccountInfo), Int)
pipeDbConnectionLoop queries cChan hIn hOut accountsCache req =
    Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return (accountsCache, req)) $
    do
    q <- readChan queries
    (updatedCache, newReq) <- case q of
        CheckAccount clId clUid clNick _ -> do
            let cacheEntry = clNick `Map.lookup` accountsCache
            currentTime <- getCurrentTime
            if (isNothing cacheEntry) || (currentTime `diffUTCTime` (fst . fromJust) cacheEntry > 10 * 60) then
                do
                    SIO.hPutStrLn hIn $ show q
                    hFlush hIn

                    (clId', clUid', accountInfo) <- SIO.hGetLine hOut >>= (maybeException . maybeRead)

                    writeChan cChan $ ClientAccountInfo clId' clUid' accountInfo

                    return $ (Map.insert clNick (currentTime, accountInfo) accountsCache, req + 1)
                `Exception.onException`
                    (unGetChan queries q)
                else
                do
                    writeChan cChan $ ClientAccountInfo clId clUid (snd $ fromJust cacheEntry)
                    return (accountsCache, req)

        GetReplayName {} -> do
            SIO.hPutStrLn hIn $ show q
            hFlush hIn

            (clId', clUid', accountInfo) <- SIO.hGetLine hOut >>= (maybeException . maybeRead)

            writeChan cChan $ ClientAccountInfo clId' clUid' accountInfo
            return (accountsCache, req)

        ClearCache -> return (Map.empty, req)
        StoreAchievements {} -> (
                (SIO.hPutStrLn hIn $ show q) >>
                hFlush hIn >>
                return (accountsCache, req))
                `Exception.onException`
                (unGetChan queries q)
        SendStats {} -> (
                (SIO.hPutStrLn hIn $ show q) >>
                hFlush hIn >>
                return (accountsCache, req))
                `Exception.onException`
                (unGetChan queries q)

    pipeDbConnectionLoop queries cChan hIn hOut updatedCache newReq
    where
        maybeException (Just a) = return a
        maybeException Nothing = ioError (userError "Can't read")

pipeDbConnection ::
        Map.Map ByteString (UTCTime, AccountInfo)
        -> ServerInfo
        -> Int
        -> IO ()

pipeDbConnection accountsCache si errNum = do
    (updatedCache, newErrNum) <-
        Exception.handle (\(e :: Exception.IOException) -> warningM "Database" (show e) >> return (accountsCache, errNum + 1)) $ do
            (Just hIn, Just hOut, _, _) <- createProcess (proc "./OfficialServer/extdbinterface" [])
                    {std_in = CreatePipe,
                    std_out = CreatePipe}
            hSetBuffering hIn LineBuffering
            hSetBuffering hOut LineBuffering

            B.hPutStrLn hIn $ dbHost si
            B.hPutStrLn hIn $ dbName si
            B.hPutStrLn hIn $ dbLogin si
            B.hPutStrLn hIn $ dbPassword si
            (c, r) <- pipeDbConnectionLoop (dbQueries si) (coreChan si) hIn hOut accountsCache 0
            return (c, if r > 0 then 0 else errNum + 1)

    when (newErrNum > 1) $ flushRequests si
    threadDelay (3000000)
    pipeDbConnection updatedCache si newErrNum

dbConnectionLoop si =
        if (not . B.null $ dbHost si) then
            pipeDbConnection Map.empty si 0
        else
            fakeDbConnection si
#else
dbConnectionLoop = fakeDbConnection
#endif

startDBConnection :: ServerInfo -> IO ()
startDBConnection serverInfo =
    forkIO (dbConnectionLoop serverInfo) >> return ()