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

import Prelude hiding (catch);
import System.Process
import System.IO
import Control.Concurrent
#if defined(NEW_EXCEPTIONS)
import qualified Control.OldException as Exception
#else
import qualified Control.Exception as Exception
#endif
import Control.Monad
import qualified Data.Map as Map
import Monad
import Maybe
import System.Log.Logger
import Data.Time
------------------------
import CoreTypes
import Utils

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

fakeDbConnection serverInfo = do
	q <- readChan $ dbQueries serverInfo
	case q of
		CheckAccount clUid _ clHost -> do
			writeChan (coreChan serverInfo) $ ClientAccountInfo (clUid,
				if clHost `elem` localAddressList then Admin else Guest)
		ClearCache -> return ()
		SendStats {} -> return ()

	fakeDbConnection serverInfo


#if defined(OFFICIAL_SERVER)
-------------------------------------------------------------------
-- borrowed from base 4.0.0 ---------------------------------------
onException :: IO a -> IO b -> IO a
onException io what = io `Exception.catch` \e -> do
		what
		Exception.throw (e :: Exception.Exception)
-- to be deleted --------------------------------------------------
-------------------------------------------------------------------


pipeDbConnectionLoop queries coreChan hIn hOut accountsCache =
	Exception.handle (\e -> warningM "Database" (show e) >> return accountsCache) $
	do
	q <- readChan queries
	updatedCache <- case q of
		CheckAccount clUid clNick _ -> do
			let cacheEntry = clNick `Map.lookup` accountsCache
			currentTime <- getCurrentTime
			if (isNothing cacheEntry) || (currentTime `diffUTCTime` (fst . fromJust) cacheEntry > 2 * 24 * 60 * 60) then
				do
					hPutStrLn hIn $ show q
					hFlush hIn

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

					writeChan coreChan $ ClientAccountInfo (clId, accountInfo)

					return $ Map.insert clNick (currentTime, accountInfo) accountsCache
				`onException`
					(unGetChan queries q)
				else
				do
					writeChan coreChan $ ClientAccountInfo (clUid, snd $ fromJust cacheEntry)
					return accountsCache

		ClearCache -> return Map.empty
		SendStats {} -> onException (
				(hPutStrLn hIn $ show q) >>
				hFlush hIn >>
				return accountsCache)
				(unGetChan queries q)

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


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

			hPutStrLn hIn $ dbHost serverInfo
			hPutStrLn hIn $ dbLogin serverInfo
			hPutStrLn hIn $ dbPassword serverInfo
			pipeDbConnectionLoop (dbQueries serverInfo) (coreChan serverInfo) hIn hOut accountsCache

	threadDelay (3 * 10^6)
	pipeDbConnection updatedCache serverInfo

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

startDBConnection serverInfo =
	forkIO $ dbConnectionLoop serverInfo