--- a/gameServer/OfficialServer/extdbinterface.hs	Wed Feb 24 00:33:10 2016 +0100
+++ b/gameServer/OfficialServer/extdbinterface.hs	Wed Feb 24 22:37:03 2016 +0300
@@ -23,6 +23,7 @@
 import Prelude hiding (catch)
 import Control.Monad
 import Control.Exception
+import Control.Monad.State
 import System.IO
 import Data.Maybe
 import Database.MySQL.Simple
@@ -36,6 +37,7 @@
 import CoreTypes
 import Utils
 
+io = liftIO
 
 dbQueryAccount =
     "SELECT CASE WHEN users.status = 1 THEN users.pass ELSE '' END, \
@@ -62,6 +64,7 @@
 
 dbQueryReplayFilename = "SELECT filename FROM achievements WHERE id = ?"
 
+dbQueryBestTime = "SELECT MIN(value) FROM achievements WHERE location = ?"
 
 dbInteractionLoop dbConn = forever $ do
     q <- liftM read getLine
@@ -94,7 +97,7 @@
         SendStats clients rooms ->
                 void $ execute dbConn dbQueryStats (clients, rooms)
         StoreAchievements p fileName teams g info ->
-            sequence_ $ parseStats dbConn p fileName teams g info
+            parseStats dbConn p fileName teams g info
 
 
 --readTime = read . B.unpack . B.take 19 . B.drop 8
@@ -107,28 +110,47 @@
     -> [(B.ByteString, B.ByteString)] 
     -> GameDetails
     -> [B.ByteString]
-    -> [IO Int64]
-parseStats dbConn p fileName teams (GameDetails script infRopes vamp infAttacks) = ps
+    -> IO ()
+parseStats dbConn p fileName teams (GameDetails script infRopes vamp infAttacks) d = evalStateT (ps d) ("", maxBound)
     where
     time = readTime fileName
-    ps :: [B.ByteString] -> [IO Int64]
-    ps [] = []
-    ps ("DRAW" : bs) = execute dbConn dbQueryGamesHistory (script, (fromIntegral p) :: Int, fileName, time, vamp, infRopes, infAttacks)
-        : places (map drawParams teams)
-        : ps bs
-    ps ("WINNERS" : n : bs) = let winNum = readInt_ n in execute dbConn dbQueryGamesHistory (script, (fromIntegral p) :: Int, fileName, time, vamp, infRopes, infAttacks)
-        : places (map (placeParams (take winNum bs)) teams)
-        : ps (drop winNum bs)
-    ps ("ACHIEVEMENT" : typ : teamname : location : value : bs) = execute dbConn dbQueryAchievement
-        ( time
-        , typ
-        , fromMaybe "" (lookup teamname teams)
-        , (readInt_ value) :: Int
-        , fileName
-        , location
-        , (fromIntegral p) :: Int
-        ) : ps bs
+    ps :: [B.ByteString] -> StateT (B.ByteString, Int) IO ()
+    ps [] = return ()
+    ps ("DRAW" : bs) = do
+        io $ execute dbConn dbQueryGamesHistory (script, (fromIntegral p) :: Int, fileName, time, vamp, infRopes, infAttacks)
+        io $ places (map drawParams teams)
+        ps bs
+    ps ("WINNERS" : n : bs) = do
+        let winNum = readInt_ n
+        io $ execute dbConn dbQueryGamesHistory (script, (fromIntegral p) :: Int, fileName, time, vamp, infRopes, infAttacks)
+        io $ places (map (placeParams (take winNum bs)) teams)
+        ps (drop winNum bs)
+    ps ("ACHIEVEMENT" : typ : teamname : location : value : bs) = do
+        let result = readInt_ value
+        io $ execute dbConn dbQueryAchievement
+            ( time
+            , typ
+            , fromMaybe "" (lookup teamname teams)
+            , result
+            , fileName
+            , location
+            , (fromIntegral p) :: Int
+            )
+        modify $ \st@(l, s) -> if result < s then (location, result) else st
+        ps bs
+    ps ("GHOST_POINTS" : n : bs) = do
+        let pointsNum = readInt_ n
+        (loc, time) <- get
+        res <- io $ query dbConn dbQueryBestTime $ Only loc
+        let bestTime = case res of
+                [Only a] -> a
+                _ -> maxBound :: Int
+        when (time < bestTime) $ do
+            -- store it
+            return ()
+        ps (drop (2 * pointsNum) bs)
     ps (b:bs) = ps bs
+
     drawParams t = (snd t, 0 :: Int)
     placeParams winners t = (snd t, if (fst t) `elem` winners then 1 else 2 :: Int)
     places :: [(B.ByteString, Int)] -> IO Int64