diff --git a/hcheckers.cabal b/hcheckers.cabal
--- a/hcheckers.cabal
+++ b/hcheckers.cabal
@@ -4,10 +4,10 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 635560919d6a9de9e4c5b6a6b7f636cc443c21aa7be4d1d72d363288b4404426
+-- hash: b7d691d6b82b6e15d986f5c2f31becaaeb09f9c1ea620d4a27ee842c5067f771
 
 name:           hcheckers
-version:        0.1.0.1
+version:        0.1.0.2
 synopsis:       Implementation of checkers ("draughts") board game - server application
 description:    Please see the README on GitHub at <https://github.com/githubuser/hcheckers#readme>
 category:       Games
@@ -52,7 +52,6 @@
       Core.Logging
       Core.Monitoring
       Core.Parallel
-      Core.Rest
       Core.Supervisor
       Core.Types
       Formats.Compact
@@ -60,6 +59,9 @@
       Formats.Pdn
       Formats.Types
       Learn
+      Rest.Battle
+      Rest.Common
+      Rest.Game
       Rules.Armenian
       Rules.Brazilian
       Rules.Canadian
@@ -77,7 +79,8 @@
       src
   ghc-options: -threaded -rtsopts -with-rtsopts=-N -O2 -fwarn-unused-imports
   build-depends:
-      aeson
+      Glob
+    , aeson
     , array
     , base >=4.7 && <5
     , binary
@@ -99,8 +102,10 @@
     , heavy-logger
     , hsyslog
     , http-types
+    , list-t
     , megaparsec
     , microlens
+    , modern-uri
     , monad-metrics
     , mtl
     , mwc-random
@@ -110,6 +115,7 @@
     , random
     , random-access-file
     , random-shuffle
+    , req
     , scotty
     , stm
     , stm-containers
diff --git a/src/AI.hs b/src/AI.hs
--- a/src/AI.hs
+++ b/src/AI.hs
@@ -8,15 +8,11 @@
 
 module AI where
 
-import Data.Maybe
 import Data.Default
 import Data.Aeson
 
 import Core.Types
-import Core.Board
-import Core.Logging
-import Core.Supervisor
-import Core.Evaluator
+import Core.Supervisor () -- import instances only
 import AI.AlphaBeta.Types
 
 loadAi :: (GameRules rules) => String -> rules -> FilePath -> IO (AlphaBeta rules (EvaluatorForRules rules))
@@ -28,4 +24,10 @@
       let rules' = SomeRules rules
           ai = AlphaBeta def rules (dfltEvaluator rules)
       return $ updateAi ai value
+
+parseAi :: (GameRules rules) => rules -> Value -> AlphaBeta rules (EvaluatorForRules rules)
+parseAi rules json =
+      let rules' = SomeRules rules
+          ai = AlphaBeta def rules (dfltEvaluator rules)
+      in  updateAi ai json
 
diff --git a/src/AI/AlphaBeta.hs b/src/AI/AlphaBeta.hs
--- a/src/AI/AlphaBeta.hs
+++ b/src/AI/AlphaBeta.hs
@@ -34,20 +34,14 @@
 
 import Core.Types
 import Core.Board
-import Core.BoardMap (labelSetMember)
+import Core.BoardMap
 import Core.Game
 import Core.Parallel
 import Core.Logging
 import qualified Core.Monitoring as Monitoring
 import AI.AlphaBeta.Types
 import AI.AlphaBeta.Cache
-
-chunksOf :: Int -> [a] -> [[a]]
-chunksOf n list
-  | length list <= n = [list]
-  | otherwise =
-      let (first, other) = splitAt n list
-      in  first : chunksOf n other
+import AI.AlphaBeta.Persistent
 
 concatE :: [Int] -> [Either e [a]] -> [Either e a]
 concatE _ [] = []
@@ -87,7 +81,7 @@
         Object evalV = toJSON eval
     in  Object $ H.union paramsV evalV
 
-instance (GameRules rules, Evaluator eval) => GameAi (AlphaBeta rules eval) where
+instance (GameRules rules, VectorEvaluator eval, ToJSON eval) => GameAi (AlphaBeta rules eval) where
 
   type AiStorage (AlphaBeta rules eval) = AICacheHandle rules eval
 
@@ -95,8 +89,8 @@
     cache <- loadAiCache scoreMoveGroup ai
     return cache
 
-  saveAiStorage (AlphaBeta params rules _) cache = do
-      -- saveAiCache rules params cache
+  saveAiStorage (AlphaBeta params rules _) handle = do
+      saveAiData rules (aichData handle)
       return ()
 
   resetAiStorage ai cache = do
@@ -114,8 +108,8 @@
 
   aiName _ = "default"
 
-instance (GameRules rules, VectorEvaluator eval) => VectorAi (AlphaBeta rules eval) where
-  type VectorAiSupport (AlphaBeta rules eval) r = (VectorEvaluatorSupport eval r, rules ~ r)
+instance (GameRules rules, VectorEvaluator eval, ToJSON eval) => VectorAi (AlphaBeta rules eval) where
+  type VectorAiSupport (AlphaBeta rules eval) r = (rules ~ r)
 
   aiToVector (AlphaBeta params rules eval) = aiVector V.++ evalVector
     where
@@ -147,7 +141,7 @@
       eval = evalFromVector rules v'
 
 -- | Calculate score of one possible move.
-scoreMove :: (GameRules rules, Evaluator eval) => ScoreMoveInput rules eval -> Checkers MoveAndScore
+scoreMove :: (GameRules rules, VectorEvaluator eval) => ScoreMoveInput rules eval -> Checkers MoveAndScore
 scoreMove (ScoreMoveInput {..}) = do
      let AlphaBeta params rules eval = smiAi
      score <- Monitoring.timed "ai.score.move" $ do
@@ -162,7 +156,7 @@
      
      return $ MoveAndScore smiMove score
 
-scoreMoveGroup :: (GameRules rules, Evaluator eval) => [ScoreMoveInput rules eval] -> Checkers [MoveAndScore]
+scoreMoveGroup :: (GameRules rules, VectorEvaluator eval) => [ScoreMoveInput rules eval] -> Checkers [MoveAndScore]
 scoreMoveGroup inputs = go worst [] inputs
   where
     input0 = head inputs
@@ -229,24 +223,25 @@
 --     return result
 
 class Monad m => EvalMoveMonad m where
-  checkPrimeVariation :: (GameRules rules, Evaluator eval) => AICacheHandle rules eval -> AlphaBetaParams -> Board -> DepthParams -> m (Maybe PerBoardData)
+  checkPrimeVariation :: (GameRules rules, VectorEvaluator eval) => AICacheHandle rules eval -> eval -> AlphaBetaParams -> Board -> DepthParams -> m (Maybe PerBoardData)
   getKillerMove :: Int -> m (Maybe MoveAndScore)
 
 instance EvalMoveMonad Checkers where
-  checkPrimeVariation var params board dp = do
-      lookupAiCache params board dp var
+  checkPrimeVariation var eval params board dp = do
+      lookupAiCache eval params board dp var
 
   getKillerMove _ = return Nothing
 
 -- ScoreM instance
 instance EvalMoveMonad (StateT (ScoreState rules eval) Checkers) where
-  checkPrimeVariation var params board dp = do
-      lift $ lookupAiCache params board dp var
+  checkPrimeVariation var eval params board dp = do
+      lift $ lookupAiCache eval params board dp var
 
   getKillerMove = getGoodMove
   
-evalMove :: (EvalMoveMonad m, GameRules rules, Evaluator eval)
-        => AlphaBetaParams
+evalMove :: (EvalMoveMonad m, GameRules rules, VectorEvaluator eval)
+        => eval
+        -> AlphaBetaParams
         -> AICacheHandle rules eval
         -> Side
         -> DepthParams
@@ -254,8 +249,8 @@
         -> Maybe PossibleMove
         -> LabelSet
         -> PossibleMove -> m Int
-evalMove params var side dp board mbPrevMove attacked move = do
-  prime <- checkPrimeVariation var params board dp
+evalMove eval params var side dp board mbPrevMove attacked move = do
+  prime <- checkPrimeVariation var eval params board dp
   let victimFields = pmVictims move
       -- nVictims = sum $ map victimWeight victimFields
       promotion = if isPromotion move then 1 else 0
@@ -304,8 +299,9 @@
           signedScore = if maximize then score else -score
       return $ fromIntegral signedScore
 
-sortMoves :: (EvalMoveMonad m, GameRules rules, Evaluator eval)
-          => AlphaBetaParams
+sortMoves :: (EvalMoveMonad m, GameRules rules, VectorEvaluator eval)
+          => eval
+          -> AlphaBetaParams
           -> AICacheHandle rules eval
           -> Side
           -> DepthParams
@@ -313,12 +309,12 @@
           -> Maybe PossibleMove
           -> [PossibleMove]
           -> m [PossibleMove]
-sortMoves params var side dp board mbPrevMove moves = do
+sortMoves eval params var side dp board mbPrevMove moves = do
 --   if length moves >= 4
 --     then do
       let rules = aichRules var
           attacked = boardAttacked side board
-      interest <- mapM (evalMove params var side dp board mbPrevMove attacked) moves
+      interest <- mapM (evalMove eval params var side dp board mbPrevMove attacked) moves
       if any (/= 0) interest
         then return $ map fst $ sortOn (negate . snd) $ zip moves interest
         else return moves
@@ -779,7 +775,7 @@
           return (goodMoves, maxScore)
 
 -- | Calculate score of the board
-doScore :: (GameRules rules, Evaluator eval)
+doScore :: (GameRules rules, VectorEvaluator eval)
         => rules
         -> eval
         -> AICacheHandle rules eval
@@ -793,7 +789,7 @@
         -> Checkers Score
 doScore rules eval var params gameId side dp board alpha beta = do
     initState <- mkInitState
-    out <- evalStateT (cachedScoreAB var params input) initState
+    out <- evalStateT (cachedScoreAB var eval params input) initState
     return $ soScore out
   where
     input = ScoreInput side dp alpha beta board Nothing 
@@ -812,19 +808,20 @@
 
 -- | Calculate score of the board. 
 -- This uses the cache. It is called in the recursive call also.
-cachedScoreAB :: forall rules eval. (GameRules rules, Evaluator eval)
+cachedScoreAB :: forall rules eval. (GameRules rules, VectorEvaluator eval)
               => AICacheHandle rules eval
+              -> eval
               -> AlphaBetaParams
               -> ScoreInput
               -> ScoreM rules eval ScoreOutput
-cachedScoreAB var params input = do
+cachedScoreAB var eval params input = do
   let depth = dpCurrent dp
       side = siSide input
       board = siBoard input
       dp = siDepth input
       alpha = siAlpha input
       beta = siBeta input
-  mbItem <- lift $ lookupAiCache params board dp var
+  mbItem <- lift $ lookupAiCache eval params board dp var
   mbCached <- case mbItem of
                 Just item -> do
                   let cachedScore = itemScore item
@@ -844,7 +841,7 @@
   case mbCached of
     Just out -> return out
     Nothing -> do
-      out <- Monitoring.timed "ai.score.board" $ scoreAB var params input
+      out <- Monitoring.timed "ai.score.board" $ scoreAB var eval params input
       let score = soScore out
           bound
             | score <= alpha = Alpha
@@ -856,8 +853,8 @@
           item = PerBoardData (dpLast dp) score bound
           item' = PerBoardData (dpLast dp) (negate score) bound
       when (bound == Exact && soQuiescene out && not (dpStaticMode dp)) $ do
-          lift $ putAiCache params board item var
-          lift $ putAiCache params (flipBoard board) item' var
+          lift $ putAiCache eval params board item var
+          lift $ putAiCache eval params (flipBoard board) item' var
       return out
 
 -- | Check if target depth is reached
@@ -927,12 +924,13 @@
 
 -- | Calculate score for the board.
 -- This implements the alpha-beta section algorithm itself.
-scoreAB :: forall rules eval. (GameRules rules, Evaluator eval)
+scoreAB :: forall rules eval. (GameRules rules, VectorEvaluator eval)
         => AICacheHandle rules eval
+        -> eval
         -> AlphaBetaParams
         -> ScoreInput
         -> ScoreM rules eval ScoreOutput
-scoreAB var params input
+scoreAB var eval params input
   | alpha == beta = do
       $verbose "Alpha == Beta == {}, return it" (Single $ show alpha)
       quiescene <- checkQuiescene
@@ -985,7 +983,7 @@
                   rules <- gets ssRules
                   dp' <- updateDepth params moves dp
                   let prevMove = siPrevMove input
-                  moves' <- sortMoves params var side dp board prevMove moves
+                  moves' <- sortMoves eval params var side dp board prevMove moves
 --                   let depths = correspondingDepths (length moves') score0 quiescene dp'
                   let depths = repeat dp'
                   out <- iterateMoves $ zip3 [1..] moves' depths
@@ -1120,9 +1118,9 @@
         let inputs = [input {siAlpha = alpha, siBeta = beta} | (alpha, beta) <- intervals]
         go inputs
       where
-        go [input] = cachedScoreAB var params input
+        go [input] = cachedScoreAB var eval params input
         go (input : inputs) = do
-          out <- cachedScoreAB var params input
+          out <- cachedScoreAB var eval params input
           let score = soScore out
           if maximize && score >= beta || minimize && score <= alpha
             then go inputs
@@ -1156,7 +1154,7 @@
                     , siBoard = markAttacked rules $ applyMoveActions (pmResult move) board
                     , siDepth = dp
                   }
-      out <- cachedScoreAB var params input'
+      out <- cachedScoreAB var eval params input'
       let score = soScore out
       $verbose "{}| score for side {}: {}" (indent, show side, show score)
 
diff --git a/src/AI/AlphaBeta/Cache.hs b/src/AI/AlphaBeta/Cache.hs
--- a/src/AI/AlphaBeta/Cache.hs
+++ b/src/AI/AlphaBeta/Cache.hs
@@ -13,24 +13,13 @@
     resetAiCache
   ) where
 
-import Control.Monad
+import Control.Concurrent
 import Control.Monad.State
 import Control.Monad.Reader
-import Control.Monad.Catch
-import Control.Concurrent
 import Control.Concurrent.STM
-import Control.Exception (SomeException)
-import qualified Control.Concurrent.ReadWriteLock as RWL
+import qualified StmContainers.Map as SM
 import qualified Data.Map as M
-import qualified Data.HashPSQ as PQ
-import Data.Maybe
 import Data.Text.Format.Heavy (Single (..))
-import System.FilePath
-import System.Environment
-import System.Directory
-import System.Posix.IO
-import qualified System.IO.RandomAccessFile as File
-import System.Clock
 import System.Log.Heavy
 import System.Log.Heavy.TH
 
@@ -42,6 +31,28 @@
 import AI.AlphaBeta.Types
 import AI.AlphaBeta.Persistent
 
+putAiData :: VectorEvaluator eval => AIData -> eval -> Board -> PerBoardData -> Checkers ()
+putAiData aiData eval board item =
+  liftIO $ atomically $ do
+    perEval <- readTVar aiData
+    let vec = evalToVector eval
+    forEval <- case M.lookup vec perEval of
+                 Just map -> return map
+                 Nothing -> do
+                    map <- SM.new
+                    writeTVar aiData $ M.insert vec map perEval
+                    return map
+    putBoardMapWith' forEval (<>) board item
+
+lookupAiData :: VectorEvaluator eval => AIData -> eval -> Board -> Checkers (Maybe PerBoardData)
+lookupAiData aiData eval board =
+  liftIO $ atomically $ do
+    perEval <- readTVar aiData
+    let vec = evalToVector eval
+    case M.lookup vec perEval of
+      Nothing -> return Nothing
+      Just forEval -> lookupBoardMap' forEval board
+
 -- | Prepare AI storage instance.
 -- This also contains Processor instance with several threads.
 loadAiCache :: (GameRules rules, Evaluator eval)
@@ -52,58 +63,9 @@
   let getKey inputs = map smiIndex inputs
   aiCfg <- asks (gcAiConfig . csConfig)
   processor <- runProcessor (aiThreads aiCfg) getKey scoreMove
-  cache <- liftIO newTBoardMap
-  cachePath <- do
-              home <- liftIO $ getEnv "HOME"
-              let directory = home </> ".cache" </> "hcheckers" </> rulesName rules </> "ai.cache"
-              liftIO $ createDirectoryIfMissing True directory
-              return directory
-  let indexPath = cachePath </> "index"
-      dataPath = cachePath </> "data"
-
-  writeQueue <- liftIO $ atomically newTChan
-  cleanupQueue <- liftIO $ atomically $ newTVar PQ.empty
-  load <- asks (aiLoadCache . gcAiConfig . csConfig)
-  store <- asks (aiStoreCache . gcAiConfig . csConfig)
-  let mbMode
-        | store = Just ReadWrite
-        | load = Just ReadOnly
-        | otherwise = Nothing
-  (indexFile, dataFile, exist) <- case mbMode of
-                    Nothing -> return (Nothing, Nothing, False)
-                    Just mode -> do
-                      indexExists <- liftIO $ doesFileExist indexPath
-                      dataExists <- liftIO $ doesFileExist dataPath
-                      let exist = dataExists && indexExists
-                      if load && not store && not exist
-                        then return (Nothing, Nothing, exist)
-                        else liftIO $ do
-                          let page = 1024*1024
-                              params = File.MMapedParams page True
-                          indexFd <- File.initFile params indexPath
-                          dataFd <- File.initFile params dataPath
-                          return (Just indexFd, Just dataFd, exist)
-  when (isJust mbMode) $
-      $info "Opened cache: {}" (Single cachePath)
+  cache <- loadAiData rules
 
   st <- ask
-  indexLock <- liftIO RWL.new
-  dataLock <- liftIO RWL.new
-  indexBlockLocks <- liftIO $ atomically $ newTVar M.empty
-  dataBlockLocks <- liftIO $ atomically $ newTVar M.empty
-
-  let indexHandle = case indexFile of
-        Nothing -> Nothing
-        Just fd -> Just $ FHandle {
-                     fhOffset = 0,
-                     fhHandle = fd
-                   }
-  let dataHandle = case dataFile of
-        Nothing -> Nothing
-        Just fd -> Just $ FHandle {
-                     fhOffset = 0,
-                     fhHandle = fd
-                   }
   counts <- liftIO $ atomically $ newTVar $ BoardCounts 50 50 50 50
   moves <- liftIO newTBoardMap
   scoreShift <- liftIO $ atomically $ newTVar M.empty
@@ -115,40 +77,20 @@
       aichProcessor = processor,
       aichPossibleMoves = moves,
       aichLastMoveScoreShift = scoreShift,
-      aichWriteQueue = writeQueue,
-      aichCleanupQueue = cleanupQueue,
-      aichCurrentCounts = counts,
-      aichIndexFile = indexHandle,
-      aichDataFile = dataHandle
+      aichCurrentCounts = counts
     }
-  when (store && isJust indexFile && not exist) $ do
-     runStorage handle initFile
-  when store $
-    forkCheckers $ cacheDumper rules params handle
-  -- forkCheckers $ cacheCleaner handle
 
-  return handle
-
-cacheDumper :: (GameRules rules, Evaluator eval) => rules -> AlphaBetaParams -> AICacheHandle rules eval -> Checkers ()
-cacheDumper rules params handle = do
-  store <- asks (aiStoreCache . gcAiConfig . csConfig)
-  when store $ forever $ do
-    repeatTimed "write" 30 $ do
-      -- threadDelay $ 100*1000
-      mbRecord <- liftIO $ atomically $ checkWriteQueue (aichWriteQueue handle)
-      case mbRecord of
-        Nothing -> return False
-        Just (board, value) -> do
-          Monitoring.increment "cache.records.writen"
-          runStorage handle $
-              putRecordFile board value
-          return True
+  save <- asks (aiStoreCache . gcAiConfig . csConfig)
+  when save $
+      forkCheckers $ aiStorageSaver rules cache
 
-    liftIO $ threadDelay $ 30 * 1000 * 1000
+  return handle
 
-cacheCleaner :: AICacheHandle rules eval -> Checkers ()
-cacheCleaner handle = forever $ do
-    liftIO $ threadDelay $ 30 * 1000 * 1000
+aiStorageSaver :: GameRules rules => rules -> AIData -> Checkers ()
+aiStorageSaver rules aiData = do
+      saveAiData rules aiData
+      liftIO $ threadDelay $ 10 * 1000 * 1000
+      aiStorageSaver rules aiData
 
 normalize :: BoardSize -> (BoardCounts,BoardKey,Side) -> (BoardCounts,BoardKey,Side)
 normalize bsize (bc,bk,side) =
@@ -160,41 +102,23 @@
 
 -- | Look up for item in the cache. First lookup in the memory,
 -- then in the file (if it is open).
-lookupAiCache :: (GameRules rules, Evaluator eval) => AlphaBetaParams -> Board -> DepthParams -> AICacheHandle rules eval -> Checkers (Maybe PerBoardData)
-lookupAiCache params board depth handle = do
+lookupAiCache :: (GameRules rules, VectorEvaluator eval) => eval -> AlphaBetaParams -> Board -> DepthParams -> AICacheHandle rules eval -> Checkers (Maybe PerBoardData)
+lookupAiCache eval params board depth handle = do
     mbItem <- lookupMemory board
     case mbItem of
       Just item -> do
         Monitoring.increment "cache.hit.memory"
         return $ Just item
       Nothing -> do
-        mbFile <- lookupFile' board depth
-        case mbFile of
-          Nothing -> do
-            Monitoring.increment "cache.miss"
-            return Nothing
-          Just file -> do
-            putAiCache params board file handle
-            return $ Just file
-
+        Monitoring.increment "cache.miss"
+        return Nothing
   where
 
-    avg :: Stats -> Score
-    avg s =
-      let Score n p = statsSumScore s
-          cnt = statsCount s
-      in  Score (n `div` cnt) (p `div` cnt)
-
-    checkStats :: Stats -> Maybe Stats
-    checkStats s
-      | statsCount s < 10 = Nothing
-      | otherwise = Just s
-
     lookupMemory :: Board -> Checkers (Maybe PerBoardData)
     lookupMemory board = Monitoring.timed "cache.lookup.memory" $ do
       cfg <- asks (gcAiConfig . csConfig)
       let cache = aichData handle
-      mbItem <- liftIO $ lookupBoardMap cache board 
+      mbItem <- lookupAiData cache eval board 
       case mbItem of
         Nothing -> return Nothing
         Just item@(PerBoardData {..}) ->
@@ -202,48 +126,24 @@
             then return $ Just item
             else return Nothing
 
-    lookupFile' :: Board -> DepthParams -> Checkers (Maybe PerBoardData)
-    lookupFile' board depth = do
-      load <- asks (aiLoadCache . gcAiConfig . csConfig)
-      if load
-        then do
-          let bc = calcBoardCounts board
-          let total = bcFirstMen bc + bcSecondMen bc + bcFirstKings bc + bcSecondKings bc
-          cfg <- asks (gcAiConfig . csConfig)
-          if {-total <= aiUseCacheMaxPieces cfg &&-} dpTarget depth >= aiUseCacheMaxDepth cfg
-            then runStorage handle (lookupFile board depth)
-                  `catch`
-                      \(e :: SomeException) -> do
-                          $reportError "Exception: lookupFile: {}" (Single $ show e)
-                          return Nothing
-            else return Nothing
-        else return Nothing
-
 -- | Put an item to the cache.
 -- It is always writen to the memory,
 -- and it is writen to the file if it is open.
-putAiCache :: GameRules rules => AlphaBetaParams -> Board -> StorageValue -> AICacheHandle rules eval -> Checkers ()
-putAiCache params board newItem handle = do
+putAiCache :: (GameRules rules, VectorEvaluator eval) => eval -> AlphaBetaParams -> Board -> StorageValue -> AICacheHandle rules eval -> Checkers ()
+putAiCache eval params board newItem handle = do
   let bc = calcBoardCounts board
   let bsize = boardSize (aichRules handle)
   let total = bcFirstMen bc + bcSecondMen bc + bcFirstKings bc + bcSecondKings bc
   let depth = itemDepth newItem
   cfg <- asks (gcAiConfig . csConfig)
-  let needWriteFile = {-total <= aiUpdateCacheMaxPieces cfg &&-} depth > aiUpdateCacheMaxDepth cfg
   Monitoring.timed "cache.put.memory" $ do
-    now <- liftIO $ getTime RealtimeCoarse
     Monitoring.increment "cache.records.put"
-    fileCacheEnabled <- asks (aiStoreCache . gcAiConfig . csConfig)
     let cache = aichData handle
-    liftIO $ putBoardMapWith cache (<>) board newItem
-
-    liftIO $ atomically $ do
-      when (fileCacheEnabled && needWriteFile) $
-          putWriteQueue (aichWriteQueue handle) (board, newItem)
-      -- putCleanupQueue (aichCleanupQueue handle) (bc, bk) now
+    putAiData cache eval board newItem
 
 resetAiCache :: AICacheHandle rules eval -> Checkers ()
-resetAiCache handle= do
+resetAiCache handle = do
   let cache = aichData handle
-  liftIO $ resetBoardMap cache
+  liftIO $ atomically $
+    writeTVar cache M.empty
 
diff --git a/src/AI/AlphaBeta/Persistent.hs b/src/AI/AlphaBeta/Persistent.hs
--- a/src/AI/AlphaBeta/Persistent.hs
+++ b/src/AI/AlphaBeta/Persistent.hs
@@ -9,24 +9,19 @@
 {-# LANGUAGE TemplateHaskell #-}
 
 module AI.AlphaBeta.Persistent
-  (lookupFile,
-   putRecordFile,
-   putStatsFile,
-   putWriteQueue,
-   checkWriteQueue,
-   initFile,
-   -- checkDataFile',
-   loadIndexIO
-  ) where
+  where
 
 import Control.Monad
 import Control.Monad.State
+import Control.Monad.Reader
+import qualified ListT
 import Control.Monad.Catch (catch, SomeException)
 import Control.Concurrent.STM
-import qualified Data.HashPSQ as PQ
+import qualified StmContainers.Map as SM
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.Map as M
+import qualified Data.Vector as V
 import Data.Maybe
 import Data.Word
 import Data.Text.Format.Heavy
@@ -38,12 +33,16 @@
 import Text.Printf
 import GHC.Generics
 import System.Posix.Types
-import qualified System.IO.RandomAccessFile as File
 import System.Log.Heavy
 import System.Log.Heavy.TH
+import System.Environment
+import System.FilePath
+import System.FilePath.Glob
+import System.Directory
 
 import Core.Types
 import Core.Board
+import Core.BoardMap
 import qualified Core.Monitoring as Monitoring
 import AI.AlphaBeta.Types
 
@@ -83,484 +82,63 @@
     Data.Store.VarSize fn -> fromIntegral $ fn a
     Data.Store.ConstSize n -> fromIntegral n
 
-unexistingBlock :: IndexBlockNumber
-unexistingBlock = maxBound
-
-putCleanupQueue :: CleanupQueue -> QueueKey -> TimeSpec -> STM ()
-putCleanupQueue var key now = modifyTVar var $ \queue ->
-    let cleanupDelay = TimeSpec {sec=10, nsec=0}
-    in  PQ.insert key (now + cleanupDelay) () queue
-
-checkCleanupQueue :: CleanupQueue -> TimeSpec -> STM (Maybe QueueKey)
-checkCleanupQueue var now = do
-  queue <- readTVar var
-  case PQ.minView queue of
-    Nothing -> return Nothing
-    Just (key, time, _, queue') ->
-      if time < now
-        then do
-          writeTVar var queue'
-          return $ Just key
-        else return Nothing
-
-putWriteQueue :: WriteQueue -> (Board, StorageValue) -> STM ()
-putWriteQueue = writeTChan
-
-checkWriteQueue :: WriteQueue -> STM (Maybe (Board, StorageValue))
-checkWriteQueue = tryReadTChan
-
-getFd :: FileType -> Storage FileDescriptor
-getFd file = do
-  fh <- getFh file
-  return $ fhHandle fh
-
-getFh :: FileType -> Storage FHandle
-getFh file = do
-  let selector = case file of
-                   IndexFile -> ssIndex
-                   DataFile -> ssData
-  st <- get
-  case selector st of
-    Nothing -> fail "getFh: file is not open"
-    Just fh -> return fh
-
-updateFh :: FileType -> (FHandle -> FHandle) -> Storage ()
-updateFh IndexFile fn = do
-  st <- get
-  case ssIndex st of
-    Nothing -> fail "updateFh: index file is not open"
-    Just fh -> put $ st {ssIndex = Just $ fn fh}
-updateFh DataFile fn = do
-  st <- get
-  case ssData st of
-    Nothing -> fail "updateFh: data file is not open"
-    Just fh -> put $ st {ssData = Just $ fn fh}
-
-tell :: FileType -> Storage FileOffset
-tell file = do
-  fh <- getFh file
-  return $ fhOffset fh
-
-seek :: FileType -> FileOffset -> Storage ()
-seek file offset = do
-  updateFh file $ \fh -> fh {fhOffset = offset}
-
-readBytes :: FileType -> ByteCount -> Storage B.ByteString
-readBytes file size = do
-  fd <- getFd file
-  currentOffset <- tell file
-  result <- liftIO $ File.readBytes fd (fromIntegral currentOffset) (fromIntegral size)
-  seek file $ fromIntegral size + currentOffset
-  return result
-  
-writeBytes :: FileType -> B.ByteString -> Storage ()
-writeBytes file bstr = do
-  fd <- getFd file
-  currentOffset <- tell file
-  result <- liftIO $ File.writeBytes fd (fromIntegral currentOffset) bstr
-  let size = B.length bstr
-  seek file $ fromIntegral size + currentOffset
-
-flush :: Storage ()
-flush = return ()
---   fd <- getFd
---   handle <- liftIO $ fdToHandle fd
---   liftIO $ hFlush handle
-
-isEof :: Storage Bool
-isEof = return False
---   fd <- getFd
---   handle <- liftIO $ fdToHandle fd
---   liftIO $ hIsEOF handle
-
--- | Read an item of appropriate type from file handle.
--- Warning: this cannot work with data types which size is variable.
-readData :: forall a. Data.Store.Store a => FileType -> Storage a
-readData file = do
-  bstr <- readBytes file (fromIntegral $ sizeOf (error "unknown data size to read!" :: a))
-  when (B.null bstr) $ do
-    offset <- tell file
-    fail $ "readData: unexpected EOF, offset " ++ show offset
-  liftIO $ Data.Store.decodeIO bstr
-
-writeData :: forall a. Data.Store.Store a => FileType -> a -> Storage ()
-writeData file a = do
-  let bstr = Data.Store.encode a
-  writeBytes file bstr
-
--- | Read an item of appropriate type from file handle.
--- Assumes there is data size in Word16 format before data itself.
-readDataSized :: forall a. Data.Store.Store a => FileType -> Storage a
-readDataSized file = do
-  size <- readData file :: Storage Word16
-  bstr <- readBytes file (fromIntegral size)
-  when (B.null bstr) $ do
-    offset <- tell file
-    fail $ "readDataSized: zero data size, offset " ++ show offset
-  liftIO $ Data.Store.decodeIO bstr
-
-writeDataSized :: forall a. Data.Store.Store a => FileType -> a -> Storage ()
-writeDataSized file a = do
-  let bstr = Data.Store.encode a
-  let size = (fromIntegral $ B.length bstr) :: Word16
-  writeData file size
-  writeBytes file bstr
-
-dataHeaderSize :: FileOffset
-dataHeaderSize = fromIntegral $ sizeOf (0 :: DataBlockNumber)
-
-indexHeaderSize :: FileOffset
-indexHeaderSize = fromIntegral $ sizeOf (0 :: IndexBlockNumber)
-
-indexRecordSize :: FileOffset
-indexRecordSize = fromIntegral (sizeOf (0 :: DataBlockNumber) + sizeOf (0 :: IndexBlockNumber))
-
-indexBlockSize :: BoardSize -> FileOffset
-indexBlockSize (nrows, ncols) = 256 * indexRecordSize
-
-dataBlockSize :: FileOffset
-dataBlockSize = 128
-
-calcIndexBlockOffset :: BoardSize -> IndexBlockNumber -> FileOffset
-calcIndexBlockOffset bsize n = indexHeaderSize + indexBlockSize bsize * fromIntegral n
-
-calcDataBlockOffset :: DataBlockNumber -> FileOffset
-calcDataBlockOffset n = dataHeaderSize + dataBlockSize * fromIntegral n
-
-calcIndexOffset :: BoardSize -> IndexBlockNumber -> Word8 -> FileOffset
-calcIndexOffset bsize block char =
-  calcIndexBlockOffset bsize block + fromIntegral char * indexRecordSize
-
-data IndexHeader = IndexHeader {
-    ihBlocksCount :: IndexBlockNumber
-  }
-  deriving (Show, Generic)
-
-instance Data.Store.Store IndexHeader where
-  size = ConstSize $ fromIntegral $ sizeOf (0 :: IndexBlockNumber)
-
-  poke h =
-    poke $ ihBlocksCount h
-
-  peek = do
-    n <- peek
-    return $ IndexHeader n
-
-data DataHeader = DataHeader {
-    dhBlocksCount :: DataBlockNumber
-  }
-  deriving (Show, Generic)
-
-instance Data.Store.Store DataHeader where
-  size = ConstSize $ fromIntegral $ sizeOf (0 :: DataBlockNumber)
-
-  poke h =
-    poke $ dhBlocksCount h
-
-  peek = do
-    n <- peek
-    return $ DataHeader n
-
-data IndexRecord = IndexRecord {
-    irIndexBlock :: IndexBlockNumber
-  , irDataBlock :: DataBlockNumber
-  }
-  deriving (Show)
-
-instance Store IndexRecord where
-  size = ConstSize $ fromIntegral $ sizeOf (0 :: IndexBlockNumber) + sizeOf (0 :: DataBlockNumber)
-
-  poke r = do
-    poke $ irIndexBlock r
-    poke $ irDataBlock r
-
-  peek = do
-    idxBlock <- peek
-    dataBlock <- peek
-    return $ IndexRecord idxBlock dataBlock
-
-lookupFileB :: B.ByteString -> Storage (Maybe PerBoardData)
-lookupFileB bstr = do
-    st <- get
-    case ssData st of
-      Nothing -> return Nothing
-      Just _ -> loop 0 bstr
-  where
-    loop blockNumber bstr
-      | B.length bstr == 1 = do
-          bsize <- gets ssBoardSize
-          let idxOffset = calcIndexOffset bsize blockNumber (B.head bstr)
-          seek IndexFile idxOffset
-          record <- readData IndexFile
-          let dataBlockNumber = irDataBlock record
-          if dataBlockNumber == unexistingBlock
-            then return Nothing
-            else do
-                   let dataOffset = calcDataBlockOffset dataBlockNumber
-                   seek DataFile dataOffset
-                   value <- readDataSized DataFile
-                   return $ Just value
-      | otherwise = do
-          bsize <- gets ssBoardSize
-          let idxOffset = calcIndexOffset bsize blockNumber (B.head bstr)
-          seek IndexFile idxOffset
-          record <- readData IndexFile
-          let nextBlockNumber = irIndexBlock record
-          if nextBlockNumber == unexistingBlock
-            then return Nothing
-            else loop nextBlockNumber (B.tail bstr)
-          
-
--- | Returns: (cached result, stats
-lookupFile :: Board -> DepthParams -> Storage (Maybe PerBoardData)
-lookupFile board depth = Monitoring.timed "cache.lookup.file" $ do
-  mbRecord <- lookupFileB (encodeBoard board)
-  case mbRecord of
-    Nothing -> return Nothing
-    Just record -> do
-      return $
-            if itemDepth record >= dpLast depth
-              then Just record
-              else Nothing
-
--- lookupStatsFile :: Board -> Storage (Maybe Stats)
--- lookupStatsFile board = Monitoring.timed "stats.lookup.file" $ do
---   mbItem <- lookupFileB (encodeBoard board)
---   return $ join $ boardStats `fmap` mbItem
-
-putRecordFileB :: B.ByteString -> PerBoardData -> Storage ()
-putRecordFileB bstr newData = do
-    st <- get
-    case ssData st of
-      Nothing -> return ()
-      Just _ -> tryBlock 0 bstr
-  where
-    tryBlock blockNumber bstr
-      | B.length bstr == 1 = do
-          bsize <- gets ssBoardSize
-          let idxOffset = calcIndexOffset bsize blockNumber (B.head bstr)
-          seek IndexFile idxOffset
-          record <- readData IndexFile
-          let dataBlockNumber = irDataBlock record
-          if dataBlockNumber == unexistingBlock 
-            then do
-                 Monitoring.increment "storage.data.block.created"
-                 newDataBlock <- createDataBlock
-                 let record' = record {irDataBlock = newDataBlock}
-                 seek IndexFile idxOffset
-                 writeData IndexFile record'
-                 seek DataFile $ calcDataBlockOffset newDataBlock
-                 writeDataSized DataFile newData
-                 return ()
-            else do
-                 Monitoring.increment "storage.data.block.reused"
-                 let dataOffset = calcDataBlockOffset dataBlockNumber
-                 seek DataFile dataOffset
-                 oldData <- readDataSized DataFile
-                              `catch`
-                                (\(e :: SomeException) -> do
-                                    $reportError "putRecordFileB: {}" (Single $ show e)
-                                    return mempty
-                                )
-                 let newData' = oldData <> newData
-                 seek DataFile dataOffset
-                 writeDataSized DataFile newData'
-                 return ()
-      | otherwise = do
-          bsize <- gets ssBoardSize
-          let idxOffset = calcIndexOffset bsize blockNumber (B.head bstr)
-          seek IndexFile idxOffset
-          record <- readData IndexFile
-          let nextBlockNumber = irIndexBlock record
-          if nextBlockNumber == unexistingBlock
-            then do
-                 Monitoring.increment "storage.index.block.created"
-                 newIndexBlock <- createIndexBlock
-                 let record' = record {irIndexBlock = newIndexBlock}
-                 seek IndexFile idxOffset
-                 writeData IndexFile record'
-                 tryBlock newIndexBlock (B.tail bstr)
-            else do
-                 Monitoring.increment "storage.index.block.reused"
-                 tryBlock nextBlockNumber (B.tail bstr)
-    
-    createIndexBlock = do
-      seek IndexFile 0
-      header <- readData IndexFile
-      let newBlockNumber = ihBlocksCount header + 1
-      let header' = header {ihBlocksCount = newBlockNumber}
-      bsize <- gets ssBoardSize
-      seek IndexFile 0
-      writeData IndexFile header'
-      seek IndexFile $ calcIndexBlockOffset bsize newBlockNumber
-      let empty = B.replicate (fromIntegral $ indexBlockSize bsize) 0xff
-      writeBytes IndexFile empty
-      return newBlockNumber
-
-    createDataBlock = do
-      seek DataFile 0
-      header <- readData DataFile
-      let newBlockNumber = dhBlocksCount header + 1
-      let header' = header {dhBlocksCount = newBlockNumber}
-      seek DataFile 0
-      writeData DataFile header'
-      seek DataFile $ calcDataBlockOffset newBlockNumber
-      let empty = B.replicate (fromIntegral dataBlockSize) 0
-      writeBytes DataFile empty
-      return newBlockNumber
-
-putRecordFile :: Board -> StorageValue -> Storage ()
-putRecordFile board value = Monitoring.timed "cache.put.file" $ do
-  let bstr = encodeBoard board
-  putRecordFileB bstr value
-
-putStatsFile :: Board -> Stats -> Storage ()
-putStatsFile board stats = do
-  return ()
---   let newData = PerBoardData mempty (Just stats)
---       bstr = encodeBoard board
---   putRecordFileB bstr newData
-
-initFile :: Storage ()
-initFile = do
-  seek IndexFile 0
-  writeData IndexFile $ IndexHeader 0
-  bsize <- gets ssBoardSize
-  let empty = B.replicate (fromIntegral $ indexBlockSize bsize) 0xff
-  writeBytes IndexFile empty
-  seek DataFile 0
-  writeData DataFile $ DataHeader 0
-  return ()
-
--- dumpFile :: FilePath -> IO ()
--- dumpFile path = withFile path ReadMode $ \file -> do
---       nBlocks <- readDataIO file :: IO Word16
---       printf "Number of blocks: %d\n" nBlocks
---       forM_ [0 .. hashIndiciesCount - 1] $ \hashIndexNr -> do
---         printf "Hash index #%d:\n" hashIndexNr
---         forM_ [0 .. hashesCount - 1] $ \hash -> do
---           lastBlockNr <- readDataIO file :: IO BlockNumber
---           when (lastBlockNr /= unexistingBlock) $ do
---             printf "  Hash %d, First:\tlast block #%d\n" hash lastBlockNr
---           lastBlockNr <- readDataIO file :: IO BlockNumber
---           when (lastBlockNr /= unexistingBlock) $ do
---             printf "  Hash %d, Second:\tlast block #%d\n" hash lastBlockNr
---       forM_ [0 .. nBlocks - 1] $ \blockNr -> do
---         let blockOffset = fromIntegral $ calcBlockOffset (fromIntegral blockNr)
---         hSeek file AbsoluteSeek blockOffset
---         printf "Block #%d, offset %d\n" blockNr blockOffset
---         header <- readDataIO file :: IO BlockHeader
---         let nRecords = bhRecordsCount header
---         printf "  Header: %s\n" (show header)
---         when (nRecords > 0) $ do
---           forM_ [0 .. nRecords - 1] $ \recordNr -> do
---             printf "    Record #%d:\n" recordNr
---             ((bk, depth),item) <- readDataSizedIO file :: IO (StorageKey, StorageValue)
---             printf "      Board key: %s\n" (show bk)
---             printf "      Depth: %d\n" depth
---             printf "      Value: %s\n" (show item)
-
-readDataIO :: forall a h. (Data.Store.Store a, File.FileAccess h) => h -> File.Offset -> IO a
-readDataIO file offset = do
-  bstr <- File.readBytes file offset (fromIntegral $ sizeOf (error "unknown data size to read!" :: a))
-  when (B.null bstr) $ do
-    fail $ "readDataIO: unexpected EOF, offset " ++ show offset
-  Data.Store.decodeIO bstr
-
-readDataSizedIO :: forall a h. (Data.Store.Store a, File.FileAccess h) => h -> File.Offset -> IO a
-readDataSizedIO file offset = do
-  size <- readDataIO file offset :: IO Word16
-  bstr <- File.readBytes file (offset + 2) (fromIntegral size)
-  when (B.null bstr) $ do
-    fail $ printf "readDataSizedIO: zero data size, offset %s, size %s" (show offset) (show size)
-  Data.Store.decodeIO bstr
-
-dumpIndexBlock :: File.FileAccess h => h -> BoardSize -> IndexBlockNumber -> IO ()
-dumpIndexBlock h bsize n = do
-  forM_ [0 .. 255] $ \char -> do
-    let offset = fromIntegral $ calcIndexOffset bsize n char
-    record <- readDataIO h offset
-    when (irDataBlock record /= unexistingBlock || irIndexBlock record /= unexistingBlock) $
-      printf "Char #%d: next index #%d, data block #%d\n" char (irIndexBlock record) (irDataBlock record)
-
-checkDataFile :: FilePath -> IO ()
-checkDataFile path = do
-  let params = File.MMapedParams (1024*1024) False
-  file <- File.initFile params path
-  nBlocks <- readDataIO file 0 :: IO DataBlockNumber
-  forM_ [0 .. nBlocks - 1] $ \i -> do
-      let start = fromIntegral $ calcDataBlockOffset i
-      size <- readDataIO file start :: IO Word16
-      when (size > 0) $ do
-        bstr <- File.readBytes file (start + 2) (fromIntegral size)
-        record <- Data.Store.decodeIO bstr :: IO PerBoardData
-        printf "Block #%d: data: %s\n" i (show record)
+getCachePath :: GameRules rules => rules -> Checkers FilePath
+getCachePath rules = liftIO $ do
+  home <- getEnv "HOME"
+  let directory = home </> ".cache" </> "hcheckers" </> rulesName rules
+  createDirectoryIfMissing True directory
+  return directory
 
--- checkDataFile' :: FilePath -> IO ()
--- checkDataFile' path = do
---   let params = File.MMapedParams (1024*1024) False
---   file <- File.initFile params path
---   nBlocks <- readDataIO file 0 :: IO DataBlockNumber
---   forM_ [0 .. nBlocks - 1] $ \i -> do
---       let start = fromIntegral $ calcDataBlockOffset i
---       size <- readDataIO file start :: IO Word16
---       when (size > 0) $ do
---         bstr <- File.readBytes file (fromIntegral $ start + 2) (fromIntegral size)
---         record <- Data.Store.decodeIO bstr :: IO PerBoardData
---         case boardStats record of
---           Nothing -> return ()
---           Just stats -> 
---             when (statsCount stats > 10) $
---               printf "Block #%d: data: %s\n" i (show record)
+newAiData :: Checkers AIData
+newAiData = liftIO $ atomically $ newTVar $ M.empty
 
-data ParserState = ParserState {
-    psIndex :: File.MMaped
-  , psUnfinished :: M.Map IndexBlockNumber BL.ByteString
-  , psFinished :: M.Map BL.ByteString DataBlockNumber
-  }
+loadAiData' :: FilePath -> Checkers (V.Vector Double, M.Map BoardHash PerBoardData)
+loadAiData' path = do
+  sHandle <- askSupervisor
+  sState <- liftIO $ atomically $ readTVar sHandle
+  bytes <- liftIO $ B.readFile path
+  (vec, pairs) <- liftIO $ decodeIO bytes :: Checkers (V.Vector Double, [(BoardHash, PerBoardData)])
+  $info "Load AI cache: {} - {} boards" (path, length pairs)
+  return (vec, M.fromList pairs)
 
-loadIndex :: StateT ParserState IO ()
-loadIndex = do
-    index <- gets psIndex
-    header <- liftIO $ readDataIO index 0
-    let n = ihBlocksCount header
-    forM_ [0 .. n-1] loadBlock
-  where
-    bsize = (8,8)
+loadAiData :: GameRules rules => rules -> Checkers AIData
+loadAiData rules = do
+  cachePath <- getCachePath rules
+  aiData <- newAiData
+  load <- asks (aiLoadCache . gcAiConfig . csConfig)
+  if load
+    then do
+      paths <- liftIO $ glob (cachePath </> "*.data")
+      sHandle <- askSupervisor
+      sState <- liftIO $ atomically $ readTVar sHandle
+      perEvalPairs <- forM paths $ \path -> do
+        bytes <- liftIO $ B.readFile path
+        (vec, pairs) <- liftIO $ decodeIO bytes :: Checkers (V.Vector Double, [(BoardHash, PerBoardData)])
+        $info "Load AI cache: {} - {} boards" (path, length pairs)
+        return (vec, pairs)
 
-    loadBlock :: IndexBlockNumber -> StateT ParserState IO ()
-    loadBlock i = do
-      index <- gets psIndex
-      finished <- gets psFinished
-      liftIO $ printf "Block #%d; finished: %d\n" i (M.size finished)
-      records <- forM [0 .. 255] $ \char -> do
-        let offset = calcIndexOffset bsize i char
-        liftIO $ readDataIO index (fromIntegral offset)
-      unfinished <- gets psUnfinished
-      modify $ \st -> st {psUnfinished = M.delete i (psUnfinished st)}
-      let prefix = fromMaybe "" $ M.lookup i unfinished
-      forM_ (zip [0..] records) $ \(j, record) -> do
-        let prefix' = prefix `BL.append` BL.singleton j
-        when (irDataBlock record /= unexistingBlock) $
-          modify $ \st -> st {psFinished = M.insert prefix' (irDataBlock record) (psFinished st)}
-        when (irIndexBlock record /= unexistingBlock) $
-          modify $ \st -> st {psUnfinished = M.insert (irIndexBlock record) prefix' (psUnfinished st)}
-  
-loadIndexIO :: FilePath -> IO (M.Map BL.ByteString DataBlockNumber)
-loadIndexIO indexPath = do 
-  let params = File.MMapedParams (1024*1024) False
-  index <- File.initFile params indexPath
-  let st = ParserState index M.empty M.empty
-  st' <- execStateT loadIndex st
-  File.closeFile index
-  putStrLn "index loaded."
-  return $ psFinished st'
+      let vecs = map fst perEvalPairs
+          cachesForEval = map snd perEvalPairs
+      maps <- forM cachesForEval $ \pairs -> liftIO $ atomically $ do
+                bmap <- SM.new
+                forM pairs $ \(bHash, item) -> do
+                  SM.insert item bHash bmap
+                return bmap
+      liftIO $ atomically $ do
+        aiData <- newTVar $ M.fromList $ zip vecs maps
+        return aiData
+    else
+      return aiData
 
--- loadDataIO :: FilePath -> FilePath -> IO [(Board, PerBoardData)]
--- loadDataIO indexPath dataPath = do
---   index <- loadIndexIO indexPath
---   let params = File.MMapedParams (1024*1024) False
---   file <- File.initFile params
---   forM (M.assocs index) $ \(bstr, block) -> do
-    
+saveAiData :: GameRules rules => rules -> AIData -> Checkers ()
+saveAiData rules var = do
+  cachePath <- getCachePath rules
+  perEvalMap <- liftIO $ atomically $ readTVar var
+  forM_ (zip [1..] $ M.assocs perEvalMap) $ \(i, (vec, mapForEval)) -> do
+    let path = cachePath </> show i ++ ".data"
+        getPairs = ListT.toList $ SM.listT mapForEval
+    boardsData <- liftIO $ atomically getPairs
+    let fileData = (vec, boardsData) :: (V.Vector Double, [(BoardHash, PerBoardData)])
+    liftIO $ B.writeFile path $ Data.Store.encode fileData
+    $info "Save AI cache: {} - {} boards" (path, length boardsData)
 
diff --git a/src/AI/AlphaBeta/Types.hs b/src/AI/AlphaBeta/Types.hs
--- a/src/AI/AlphaBeta/Types.hs
+++ b/src/AI/AlphaBeta/Types.hs
@@ -39,6 +39,7 @@
 import Control.Concurrent.STM
 import qualified Data.HashPSQ as PQ
 import qualified Data.Map as M
+import qualified Data.Vector as V
 import Data.Word
 import Data.Binary
 import Data.Store
@@ -59,6 +60,8 @@
 data AlphaBeta rules eval = AlphaBeta AlphaBetaParams rules eval
   deriving (Eq, Ord, Show, Typeable)
 
+type AlphaBetaR rules = AlphaBeta rules (EvaluatorForRules rules)
+
 data AlphaBetaParams = AlphaBetaParams {
     abDepth :: Depth
   , abStartDepth :: Maybe Depth
@@ -151,7 +154,7 @@
 instance Binary PerBoardData
 instance Store PerBoardData
 
-type AIData = TBoardMap PerBoardData
+type AIData = TVar (M.Map (V.Vector Double) (TBoardMap PerBoardData))
 
 type StorageKey = (DepthParams, BoardKey)
 
@@ -196,11 +199,7 @@
   , aichProcessor ::  Processor [Int] [ScoreMoveInput rules eval] [MoveAndScore]
   , aichPossibleMoves :: MovesMemo
   , aichLastMoveScoreShift :: TVar (M.Map GameId ScoreBase)
-  , aichWriteQueue :: WriteQueue
-  , aichCleanupQueue :: CleanupQueue
   , aichCurrentCounts :: TVar BoardCounts
-  , aichIndexFile :: Maybe FHandle
-  , aichDataFile :: Maybe FHandle
   }
 
 type WriteQueue = TChan (Board, StorageValue)
@@ -221,8 +220,6 @@
   , ssMetrics :: Metrics.Metrics
   , ssMetricsEnabled :: Bool
   , ssBoardSize :: BoardSize
-  , ssIndex :: Maybe FHandle
-  , ssData :: Maybe FHandle
   }
 
 -- | Storage monad.
@@ -319,11 +316,9 @@
 runStorage :: (GameRules rules, Evaluator eval) => AICacheHandle rules eval -> Storage a -> Checkers a
 runStorage handle actions = do
   lts <- asks csLogging
-  let indexHandle = aichIndexFile handle
-  let dataHandle = aichDataFile handle
   let bsize = boardSize (aichRules handle)
   metrics <- Metrics.getMetrics
   metricsEnabled <- isMetricsEnabled
-  let initState = StorageState lts metrics metricsEnabled bsize indexHandle dataHandle
+  let initState = StorageState lts metrics metricsEnabled bsize
   liftIO $ evalStateT actions initState
   
diff --git a/src/Battle.hs b/src/Battle.hs
--- a/src/Battle.hs
+++ b/src/Battle.hs
@@ -7,14 +7,18 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DataKinds #-}
 
 module Battle where
 
 import Control.Monad
 import Control.Monad.IO.Class
-import Data.List (intercalate, sortOn)
-import Data.Aeson
+import Control.Concurrent
+import Data.List (sortOn)
+import Data.Aeson hiding (json)
 import Data.Aeson.Types
+import Data.Yaml
+import Data.Maybe
 import qualified Data.Map as M
 import qualified Data.Vector as V
 import qualified Data.HashMap.Strict as H
@@ -23,14 +27,48 @@
 import Text.Printf
 import System.Random
 import System.Random.Shuffle
+import Web.Scotty.Trans
+import Network.HTTP.Req
+import Text.URI (mkURI)
 
-import Core.Types
+import Core.Types hiding (timed)
 import Core.Board
+import Core.Json () -- instances only
 import Core.Supervisor
+import Core.Parallel
+import Core.Monitoring
+import Rest.Common
 import AI.AlphaBeta.Types
+import AI
 
 type AB rules = AlphaBeta rules (EvaluatorForRules rules)
 
+type BattleRunner = SomeRules -> (Int,SomeAi) -> (Int,SomeAi) -> FilePath -> Checkers GameResult
+
+type MatchRunner = Int -> SomeRules -> [(Int,Int)] -> [SomeAi] -> Checkers [(Int, Int, Int)]
+
+data GeneticSettings = GeneticSettings {
+    gsRules :: String
+  , gsUrls :: [T.Text]
+  , gsGenerations :: Int
+  , gsGames :: Int
+  , gsGenerationSize :: Int
+  , gsPrevGeneration :: Int
+  , gsBestCount :: Int
+  , gsInitFiles :: [FilePath]
+  } deriving (Show)
+
+instance FromJSON GeneticSettings where
+  parseJSON = withObject "GeneticSettings" $ \v -> GeneticSettings
+    <$> v .: "rules"
+    <*> v .: "urls"
+    <*> v .: "generations"
+    <*> v .: "games_per_match"
+    <*> v .: "generation_size"
+    <*> v .: "keep_previous_generation"
+    <*> v .: "select_best"
+    <*> v .: "init_files"
+
 (<+>) :: Num a => V.Vector a -> V.Vector a -> V.Vector a
 v1 <+> v2 = V.zipWith (+) v1 v2
 
@@ -44,35 +82,89 @@
 -- norm v = sqrt $ V.sum $ V.map (\x -> x*x) v
 norm v = (V.sum $ V.map abs v) / fromIntegral (V.length v)
 
-cross :: (GameRules rules, VectorEvaluator (EvaluatorForRules rules), VectorEvaluatorSupport (EvaluatorForRules rules) rules) => rules -> (AB rules, AB rules) -> Checkers (AB rules)
+mix :: V.Vector a -> V.Vector a -> IO (V.Vector a)
+mix v1 v2 = do
+  t <- randomRIO (0.0, 1.0) :: IO Double
+  V.forM (V.zip v1 v2) $ \(x1, x2) -> do
+    p <- randomRIO (0.0, 1.0)
+    if p < t
+      then return x1
+      else return x2
+
+cross :: (GameRules rules, VectorEvaluator (EvaluatorForRules rules)) => rules -> (AB rules, AB rules) -> Checkers (AB rules)
 cross rules (ai1, ai2) = do
   let v1 = aiToVector ai1
       v2 = aiToVector ai2
-  t <- liftIO $ randomRIO (0.0, 1.0)
-  let mid = scale (1.0 - t) v1 <+> scale t v2
+  mid <- liftIO $ mix v1 v2
   p <- liftIO $ randomRIO (0.0, 1.0) :: Checkers Double
-  v3 <- if p < 0.9
+  v3 <- if p < 0.7
           then return mid
           else do
-            let delta = {-0.5 *-} norm (v1 <-> v2)
-            dv <- liftIO $ replicateM (V.length v1) $ randomRIO (-delta, delta)
-            -- liftIO $ print delta
-            return $ mid <+> V.fromList dv
+            let delta = 0.05
+            liftIO $ V.forM mid $ \v -> do
+                             let a = abs v
+                             randomRIO (v - delta*a, v + delta*a)
   let v3' = V.take 3 v1 V.++ V.drop 3 v3
   return $ aiFromVector rules v3'
 
-breed :: (GameRules rules, VectorEvaluator (EvaluatorForRules rules), VectorEvaluatorSupport (EvaluatorForRules rules) rules) => rules -> Int -> [AB rules] -> Checkers [AB rules]
-breed rules nNew ais = do
+breed :: (GameRules rules, VectorEvaluator (EvaluatorForRules rules)) => rules -> Int -> Int -> [AB rules] -> Checkers [AB rules]
+breed rules nNew nOld ais = do
   let n = length ais
       idxPairs = [(i,j) | i <- [0..n-1], j <- [i+1 .. n-1]]
+      nNew' = nNew - nOld
   idxPairs' <- liftIO $ shuffleM idxPairs
   let ais' = [(ais !! i, ais !! j) | (i,j) <- idxPairs']
-  mapM (cross rules) $ take nNew $ cycle ais'
+  new <- mapM (cross rules) $ take nNew' $ cycle ais'
+  let old = take nOld ais
+  return $ old ++ new
 
-runGenetics :: (GameRules rules, VectorEvaluator (EvaluatorForRules rules), VectorEvaluatorSupport (EvaluatorForRules rules) rules)
-            => rules -> Int -> Int -> Int -> [AB rules] -> Checkers [AB rules]
-runGenetics rules nGenerations generationSize nBest ais = do
-      generation0 <- breed rules generationSize ais
+runGeneticsJ :: FilePath -> Checkers [SomeAi]
+runGeneticsJ cfgPath = do
+  cfg <- liftIO $ decodeYamlFile cfgPath
+  matchRunner <- if null (gsUrls cfg)
+                    then return $ dumbMatchRunner runBattleLocal
+                    else do
+                         let process url (gameNr, rules, (i,ai1), (j,ai2), path) = do
+                                liftIO $ printf "Battle AI#%d vs AI#%d on %s\n" i j (T.unpack url)
+                                timed ("battle.duration." <> url) $ do
+                                  increment ("battle.count." <> url)
+                                  runBattleRemote url rules (i,ai1) (j,ai2) path
+                         processor <- runProcessor' (gsUrls cfg) getJobKey process
+                         return $ mkRemoteRunner processor
+  withRules (gsRules cfg) $ \rules -> do
+      ais <- forM (gsInitFiles cfg) $ \path -> liftIO $ loadAi "default" rules path
+      rs <- runGenetics matchRunner rules (gsGenerations cfg) (gsGenerationSize cfg) (gsPrevGeneration cfg) (gsBestCount cfg) (gsGames cfg) ais
+      return $ map SomeAi rs
+
+type BattleProcessor = Processor (Int,Int,Int) (Int, SomeRules, (Int,SomeAi), (Int,SomeAi), FilePath) GameResult
+
+getJobKey (gameNr, rules, (i,ai1), (j,ai2), _) = (gameNr, i,j)
+
+mkRemoteRunner :: BattleProcessor -> MatchRunner
+mkRemoteRunner processor nGames rules idxPairs ais = do
+  let inputs = [(gameNr, rules, (i, ais !! i), (j, ais !! j), "battle.pdn") | (i,j) <- idxPairs, gameNr <- [1..nGames]]
+      keys = map getJobKey inputs
+  gameResults <- process processor inputs
+  let list = [((i,j), result) | (result, (gameNr, i,j)) <- zip gameResults keys]
+      byPair = foldr (\(ij, result) m -> M.insertWith (++) ij [result] m) M.empty list
+      groupedResults = [fromJust $ M.lookup ij byPair | ij <- idxPairs]
+      totals = [calcMatchStats results | results <- groupedResults]
+  forM_ (zip idxPairs totals) $ \((i,j), (first, second, draw)) -> do
+    liftIO $ printf "Match: AI#%d: %d, AI#%d: %d, Draws(?): %d\n" i first j second draw
+  return totals
+
+runGenetics :: (GameRules rules, VectorEvaluator (EvaluatorForRules rules))
+            => MatchRunner
+            -> rules
+            -> Int           -- ^ Number of generations
+            -> Int           -- ^ Generation size
+            -> Int           -- ^ number of items to keep from previous generation
+            -> Int           -- ^ Number of best items to select for breeding
+            -> Int           -- ^ number of games in each match
+            -> [AB rules]
+            -> Checkers [AB rules]
+runGenetics runMatches rules nGenerations generationSize nOld nBest nGames ais = do
+      generation0 <- breed rules generationSize nOld ais
       run 1 generation0
   where
       run n generation = do
@@ -81,30 +173,49 @@
         if n == nGenerations
           then return best
           else do
-              generation' <- breed rules generationSize best
+              generation' <- breed rules generationSize nOld best
               run (n+1) generation'
 
-      nGames = 5
       nMatches = generationSize
 
       selectBest generation = do
-        results <- runTournament rules generation nMatches nGames
+        results <- runTournament runMatches rules generation nMatches nGames
         let best = take nBest $ sortOn (negate . snd) $ M.assocs results
             idxs = map fst best
         return [generation !! i | i <- idxs]
 
-runTournament :: (GameRules rules, VectorEvaluator (EvaluatorForRules rules)) => rules -> [AlphaBeta rules (EvaluatorForRules rules)] -> Int -> Int -> Checkers (M.Map Int Int)
-runTournament rules ais nMatches nGames = do
+mapP :: Int -> (input -> Checkers output) -> [input] -> Checkers [output]
+mapP nThreads fn inputs = do
+    let groups = splitBy nThreads inputs
+    vars <- replicateM nThreads $ liftIO $ newEmptyMVar
+    forM_ (zip groups vars) $ \(group, var) -> do
+      forkCheckers $ do
+        rs <- forM group fn
+        liftIO $ putMVar var rs
+    rsGroups <- forM vars $ \var -> liftIO $ takeMVar var
+    return $ concat rsGroups
+
+forMP :: Int -> [input] -> (input -> Checkers output) -> Checkers [output]
+forMP nThreads inputs fn = mapP nThreads fn inputs
+
+dumbMatchRunner :: BattleRunner -> MatchRunner
+dumbMatchRunner runBattle nGames rules idxPairs ais =
+  forMP 4 idxPairs $ \(i,j) ->
+      runMatch runBattle rules (i, ais !! i) (j, ais !! j) nGames
+
+runTournament :: (GameRules rules, VectorEvaluator (EvaluatorForRules rules))
+    => MatchRunner -> rules -> [AlphaBeta rules (EvaluatorForRules rules)] -> Int -> Int -> Checkers (M.Map Int Int)
+runTournament runMatches rules ais nMatches nGames = do
   forM_ ais $ \ai ->
     liftIO $ print $ aiToVector ai
   let n = length ais
       idxPairs = [(i,j) | i <- [0..n-1], j <- [i+1 .. n-1]]
       ais' = map SomeAi ais
   idxPairs' <- liftIO $ shuffleM idxPairs
-  stats <- forM (take nMatches idxPairs') $ \(i,j) ->
-             runMatch (SomeRules rules) (ais' !! i) (ais' !! j) nGames
-  forM_ (zip idxPairs' stats) $ \((i,j),(first,second,draw)) -> do
-      liftIO $ printf "AI#%d vs AI#%d: First %d, Second %d, Draw %d\n" i j first second draw
+  stats <- runMatches nGames (SomeRules rules) (take nMatches idxPairs') ais'
+  liftIO $ putStrLn "Tournament results:"
+  -- forM_ (zip idxPairs' stats) $ \((i,j),(first,second,draw)) -> do
+  --     liftIO $ printf "AI#%d vs AI#%d: First %d, Second %d, Draw %d\n" i j first second draw
 
   let results1 = [(i, first - second) | ((i,j), (first,second,draw)) <- zip idxPairs' stats]
       results2 = [(j, second - first) | ((i,j), (first,second,draw)) <- zip idxPairs' stats]
@@ -117,25 +228,36 @@
 --       liftIO $ putStrLn str
   return results
 
-runMatch :: SomeRules -> SomeAi -> SomeAi -> Int -> Checkers (Int, Int, Int)
-runMatch rules ai1 ai2 nGames = do
+runMatch :: BattleRunner -> SomeRules -> (Int, SomeAi) -> (Int, SomeAi) -> Int -> Checkers (Int, Int, Int)
+runMatch runBattle rules (i,ai1) (j,ai2) nGames = do
     (nFirst, nSecond, nDraw) <- go 0 (0, 0, 0)
-    liftIO $ printf "First: %d, Second: %d, Draws(?): %d\n" nFirst nSecond nDraw
+    liftIO $ printf "Match: AI#%d: %d, AI#%d: %d, Draws(?): %d\n" i nFirst j nSecond nDraw
     return (nFirst, nSecond, nDraw)
   where
     go :: Int -> (Int, Int, Int) -> Checkers (Int, Int, Int)
-    go i (first, second, draw)
-      | i >= nGames = return (first, second, draw)
+    go k (first, second, draw)
+      | k >= nGames = return (first, second, draw)
       | otherwise = do
-          result <- runBattle rules ai1 ai2 (printf "battle_%d.pdn" i)
+          result <- runBattle rules (i,ai1) (j,ai2) (printf "battle_%d.pdn" k)
           let stats = case result of
                         FirstWin -> (first+1, second, draw)
                         SecondWin -> (first, second+1, draw)
                         Draw -> (first, second, draw+1)
-          go (i+1) stats
+          go (k+1) stats
 
-runBattle :: SomeRules -> SomeAi -> SomeAi -> FilePath -> Checkers GameResult
-runBattle rules ai1 ai2 path = do
+calcMatchStats :: [GameResult] -> (Int, Int, Int)
+calcMatchStats rs = go (0, 0, 0) rs
+  where
+    go (first, second, draw) [] = (first, second, draw)
+    go (first, second, draw) (r : rs) =
+      let stats = case r of
+                    FirstWin -> (first+1, second, draw)
+                    SecondWin -> (first, second+1, draw)
+                    Draw -> (first, second, draw+1)
+      in go stats rs
+
+runBattleLocal :: BattleRunner
+runBattleLocal rules (i,ai1) (j,ai2) path = do
   initAiStorage rules ai1
   let firstSide = First
   gameId <- newGame rules firstSide Nothing
@@ -147,7 +269,7 @@
   resetAiStorageG gameId Second
   runGame gameId
   result <- loopGame path gameId (opposite firstSide) 0
-  liftIO $ print result
+  liftIO $ printf "Battle AI#%d vs AI#%d: %s\n" i j (show result)
   return result
 
 hasKing :: Side -> BoardRep -> Bool
@@ -159,7 +281,7 @@
 loopGame :: FilePath -> GameId -> Side -> Int -> Checkers GameResult
 loopGame path gameId side i = do
   StateRs board status side <- getState gameId
-  if (i > 100) || (i > 60 && boardRepLen board <= 8 && hasKing First board && hasKing Second board)
+  if (i > 200) || (i > 120 && boardRepLen board <= 8 && hasKing First board && hasKing Second board)
     then do
       liftIO $ putStrLn "Too long a game, probably a draw"
       -- pdn <- getPdn gameId
@@ -220,5 +342,46 @@
     Nothing -> fail "Cannot load initial AI"
     Just initValue -> forM_ [1..n] $ \i -> do
                         value <- generateVariation dv initValue
-                        encodeFile (printf "ai_variation_%d.json" i) value
+                        Data.Aeson.encodeFile (printf "ai_variation_%d.json" i) value
+
+decodeJsonFile :: FromJSON a => FilePath -> IO a
+decodeJsonFile path = do
+  r <- eitherDecodeFileStrict' path
+  case r of
+    Left err -> fail err
+    Right x -> return x
+
+decodeYamlFile :: FromJSON a => FilePath -> IO a
+decodeYamlFile path = do
+  r <- Data.Yaml.decodeFileEither path
+  case r of
+    Left err -> fail (show err)
+    Right x -> return x
+
+http_ :: T.Text -> (Url 'Http, Option s)
+http_ text =
+  case mkURI text of
+    Nothing -> error $ "Can't parse URI: " ++ T.unpack text
+    Just uri ->
+      case useHttpURI uri of
+        Nothing -> error $ "Unsupported URI: " ++ T.unpack text
+        Just (url, opts) -> (url, opts)
+
+runBattleRemote :: T.Text -> BattleRunner
+runBattleRemote baseUrl (SomeRules rules) (i,SomeAi ai1) (j,SomeAi ai2) path = do
+  let rq = BattleRq (rulesName rules) (toJSON ai1) (toJSON ai2)
+      (url, opts) = http_ baseUrl
+  rs <- liftIO $ runReq defaultHttpConfig $
+          req POST (url /: "battle" /: "run") (ReqBodyJson rq) jsonResponse opts
+  return (responseBody rs)
+
+runBattleRemoteIO :: T.Text -> String -> FilePath -> FilePath -> IO GameResult
+runBattleRemoteIO baseUrl rulesName aiPath1 aiPath2 = do
+  ai1 <- decodeJsonFile aiPath1
+  ai2 <- decodeJsonFile aiPath2
+  let rq = BattleRq rulesName ai1 ai2
+      (url, opts) = http_ baseUrl 
+  rs <- runReq defaultHttpConfig $
+          req POST (url /: "battle" /: "run") (ReqBodyJson rq) jsonResponse opts
+  return (responseBody rs)
 
diff --git a/src/Core/Board.hs b/src/Core/Board.hs
--- a/src/Core/Board.hs
+++ b/src/Core/Board.hs
@@ -342,6 +342,9 @@
 isCapture :: PossibleMove -> Bool
 isCapture pm = not $ null $ pmVictims pm
 
+isPromotionM :: Move -> Bool
+isPromotionM move = any sPromote (moveSteps move)
+
 isPromotion :: PossibleMove -> Bool
 isPromotion = pmPromote
 
@@ -748,11 +751,40 @@
 
 -- | Generic implementation of @getGameResult@, which suits most rules.
 -- This can not, however, recognize draws.
-genericGameResult :: GameRules rules => rules -> Board -> Side -> Maybe GameResult
-genericGameResult rules board side
+genericGameResult :: GameRules rules => rules -> GameState -> Board -> Side -> Maybe GameResult
+genericGameResult rules st board side
   | side == First && null (possibleMoves rules First board) = Just SecondWin
   | side == Second && null (possibleMoves rules Second board) = Just FirstWin
+  | detectRepeatedPosition 3 (gsHistory st) board = Just Draw
+  | detectStalemate (gsHistory st) board = Just Draw
   | otherwise = Nothing
+
+detectRepeatedPosition :: Int -> [HistoryRecord] -> Board -> Bool
+detectRepeatedPosition n history board =
+  case history of
+    [] -> False
+    [_] -> False
+    (record : prevRecord: history') ->
+      if hrPrevBoard record == board
+        then detectRepeatedPosition (n-1) history' (hrPrevBoard record)
+        else False
+
+detectStalemate :: [HistoryRecord] -> Board -> Bool
+detectStalemate history board
+  | totalCount board <= 3 = detectStalemate' 5 history board
+  | totalCount board <= 5 = detectStalemate' 30 history board
+  | totalCount board <= 7 = detectStalemate' 60 history board
+  | otherwise = False
+      
+detectStalemate' :: Int -> [HistoryRecord] -> Board -> Bool
+detectStalemate' nMoves history board =
+  let counts = calcBoardCounts board
+      change r = isCaptureM (hrMove r) || isPromotionM (hrMove r)
+      nHalfMoves = 2*nMoves
+  in  if bcFirstKings counts > 0 && bcSecondKings counts > 0
+        then  length history > nHalfMoves &&
+                (not $ any change $ take nHalfMoves history)
+        else False
 
 instance IsString Label where
   fromString str =
diff --git a/src/Core/BoardMap.hs b/src/Core/BoardMap.hs
--- a/src/Core/BoardMap.hs
+++ b/src/Core/BoardMap.hs
@@ -101,39 +101,28 @@
 newTBoardMap :: IO (TBoardMap a)
 newTBoardMap = atomically SM.new
 
-putBoardMap :: TBoardMap a -> Board -> a -> IO ()
-putBoardMap bmap board value = atomically $ do
+putBoardMap' :: TBoardMap a -> Board -> a -> STM ()
+putBoardMap' bmap board value = 
   SM.insert value (boardHash board) bmap
---   mbByHash <- SM.lookup (boardCounts board) bmap
---   case mbByHash of
---     Just byHash -> SM.insert value (boardHash board) byHash
---     Nothing -> do
---       byHash <- SM.new
---       SM.insert value (boardHash board) byHash
---       SM.insert byHash (boardCounts board) bmap
 
-putBoardMapWith :: TBoardMap a -> (a -> a -> a) -> Board -> a -> IO ()
-putBoardMapWith bmap plus board value = atomically $ do
+putBoardMap :: TBoardMap a -> Board -> a -> IO ()
+putBoardMap bmap board value = atomically $ putBoardMap' bmap board value
+
+putBoardMapWith' :: TBoardMap a -> (a -> a -> a) -> Board -> a -> STM ()
+putBoardMapWith' bmap plus board value = do
     mbOld <- SM.lookup (boardHash board) bmap
     case mbOld of
       Nothing -> SM.insert value (boardHash board) bmap
       Just old -> SM.insert (plus old value) (boardHash board) bmap
---   mbByHash <- SM.lookup (boardCounts board) bmap
---   byHash <- case mbByHash of
---               Nothing -> SM.new
---               Just byHash -> return byHash
---   mbOld <- SM.lookup (boardHash board) byHash
---   case mbOld of
---     Nothing -> SM.insert value (boardHash board) byHash
---     Just old -> SM.insert (plus old value) (boardHash board) byHash
 
+putBoardMapWith :: TBoardMap a -> (a -> a -> a) -> Board -> a -> IO ()
+putBoardMapWith bmap plus board value = atomically $ putBoardMapWith' bmap plus board value
+
+lookupBoardMap' :: TBoardMap a -> Board -> STM (Maybe a)
+lookupBoardMap' bmap board = SM.lookup (boardHash board) bmap
+
 lookupBoardMap :: TBoardMap a -> Board -> IO (Maybe a)
-lookupBoardMap bmap board = atomically $ do
-  SM.lookup (boardHash board) bmap
---   mbByHash <- SM.lookup (boardCounts board) bmap
---   case mbByHash of
---     Nothing -> return Nothing
---     Just byHash -> SM.lookup (boardHash board) byHash
+lookupBoardMap bmap board = atomically $ lookupBoardMap' bmap board
 
 resetBoardMap :: TBoardMap a -> IO ()
 resetBoardMap bmap = atomically $ SM.reset bmap
diff --git a/src/Core/CmdLine.hs b/src/Core/CmdLine.hs
--- a/src/Core/CmdLine.hs
+++ b/src/Core/CmdLine.hs
@@ -2,12 +2,13 @@
 module Core.CmdLine where
 
 import Options.Applicative
-import Data.Semigroup ((<>))
 import Data.Char (toLower)
 
 data CmdLine = CmdLine {
       cmdConfigPath :: Maybe FilePath
     , cmdLocal :: Maybe Bool
+    , cmdBattleServer :: Maybe Bool
+    , cmdMetrics :: Maybe Bool
     , cmdSpecial :: Maybe String
     }
   deriving (Eq, Show)
@@ -33,6 +34,16 @@
          <> short 'L'
          <> metavar "on|off"
          <> help "Run server in local mode" ) )
+  <*> optional (option bool
+        ( long "battle"
+          <> short 'B'
+          <> metavar "on|off"
+          <> help "Run `battle server' instead of normal game server") )
+  <*> optional (option bool
+        ( long "metrics"
+          <> metavar "on|off"
+          <> help "Enable or disable metrics monitoring. This command-line option overrides one specified in the config file.")
+        )
   <*> optional (strOption
         ( long "special"
          <> metavar "COMMAND" ) )
diff --git a/src/Core/Config.hs b/src/Core/Config.hs
--- a/src/Core/Config.hs
+++ b/src/Core/Config.hs
@@ -45,5 +45,8 @@
   let config' = case cmdLocal cmd of
                   Nothing -> config
                   Just local -> config {gcLocal = local}
-  return config'
+      config'' = case cmdMetrics cmd of
+                  Nothing -> config'
+                  Just metrics -> config {gcEnableMetrics = metrics}
+  return config''
 
diff --git a/src/Core/Evaluator.hs b/src/Core/Evaluator.hs
--- a/src/Core/Evaluator.hs
+++ b/src/Core/Evaluator.hs
@@ -6,8 +6,6 @@
 {-# LANGUAGE ConstraintKinds #-}
 module Core.Evaluator
   ( SimpleEvaluator (..),
-    SimpleEvaluatorInterface (..),
-    SimpleEvaluatorSupport (..),
     SimpleEvaluatorData (..),
     weightForSide,
     defaultEvaluator
@@ -38,7 +36,7 @@
   deriving (Show)
 
 data SimpleEvaluator = SimpleEvaluator {
-    seRules :: SimpleEvaluatorInterface,
+    seRules :: SomeRules,
     seUsePositionalScore :: Bool,
     seMobilityWeight :: ScoreBase,
     seBackyardWeight :: ScoreBase,
@@ -57,21 +55,7 @@
   }
   deriving (Show)
 
-class GameRules rules => SimpleEvaluatorSupport rules where
-  getBackDirections :: rules -> [PlayerDirection]
-  getBackDirections _ = [BackwardLeft, BackwardRight]
-
-  getForwardDirections :: rules -> [PlayerDirection]
-  getForwardDirections _ = [ForwardLeft, ForwardRight]
-
-  getAllAddresses :: rules -> [Address]
-
-data SimpleEvaluatorInterface = forall g. SimpleEvaluatorSupport g => SimpleEvaluatorInterface g
-
-instance Show SimpleEvaluatorInterface where
-  show (SimpleEvaluatorInterface rules) = rulesName rules
-
-defaultEvaluator :: SimpleEvaluatorSupport rules => rules -> SimpleEvaluator
+defaultEvaluator :: GameRules rules => rules -> SimpleEvaluator
 defaultEvaluator rules = SimpleEvaluator
     { seRules              = iface
     , seUsePositionalScore = True
@@ -91,7 +75,7 @@
     , seCache = buildCache iface
     }
   where
-    iface = SimpleEvaluatorInterface rules
+    iface = SomeRules rules
 
 parseEvaluator :: SimpleEvaluator -> Value -> AT.Parser SimpleEvaluator
 parseEvaluator def = withObject "Evaluator" $ \v -> SimpleEvaluator
@@ -177,8 +161,8 @@
           , psThreats = 0
         }
 
-waveRho :: SimpleEvaluatorInterface -> Side -> (Address -> Bool) -> Address -> ScoreBase -> ScoreBase
-waveRho (SimpleEvaluatorInterface rules) side isGood addr best = go addr
+waveRho :: SomeRules -> Side -> (Address -> Bool) -> Address -> ScoreBase -> ScoreBase
+waveRho (SomeRules rules) side isGood addr best = go addr
   where
     go :: Address -> ScoreBase
     go addr
@@ -191,8 +175,8 @@
                 Just dst -> max 0 $ go dst - 1
         in  maximum $ map check $ getForwardDirections rules
 
-buildCache :: SimpleEvaluatorInterface -> M.Map Address SimpleEvaluatorData
-buildCache iface@(SimpleEvaluatorInterface rules) = M.fromList [(addr, labelData addr) | addr <- getAllAddresses rules]
+buildCache :: SomeRules -> M.Map Address SimpleEvaluatorData
+buildCache iface@(SomeRules rules) = M.fromList [(addr, labelData addr) | addr <- getAllAddresses rules]
   where
     labelData addr = SimpleEvaluatorData $ SimpleEvaluatorWeights {
         sewFirst = waveRho iface First (isCenter . aLabel) addr best,
@@ -214,7 +198,7 @@
         -- && (row >= crow - halfRow && row < crow + halfRow)
 
 preEval :: SimpleEvaluator -> Side -> Board -> PreScore
-preEval (SimpleEvaluator { seRules = iface@(SimpleEvaluatorInterface rules), ..}) side board =
+preEval (SimpleEvaluator { seRules = iface@(SomeRules rules), ..}) side board =
   let
     kingCoef = seKingCoef
       -- King is much more useful when there are enough men to help it
@@ -337,7 +321,7 @@
       Nothing -> e
       Just e' -> e'
 
-  evalBoard eval@(SimpleEvaluator {seRules = SimpleEvaluatorInterface rules, ..}) whoAsks board =
+  evalBoard eval@(SimpleEvaluator {seRules = SomeRules rules, ..}) whoAsks board =
     let ps1 = preEval eval whoAsks board
         ps2 = preEval eval (opposite whoAsks) board
 
@@ -387,7 +371,6 @@
                  else (myScore - opponentScore)
 
 instance VectorEvaluator SimpleEvaluator where
-  type VectorEvaluatorSupport SimpleEvaluator rules = SimpleEvaluatorSupport rules
 
   evalToVector (SimpleEvaluator {..}) = V.fromList $ map fromIntegral $ [
         seMobilityWeight, seBackyardWeight,
@@ -417,7 +400,7 @@
         , seCache = buildCache iface
       }
     where
-      iface = SimpleEvaluatorInterface rules
+      iface = SomeRules rules
         
 
 -- data ComplexEvaluator rules = ComplexEvaluator {
diff --git a/src/Core/Game.hs b/src/Core/Game.hs
--- a/src/Core/Game.hs
+++ b/src/Core/Game.hs
@@ -95,6 +95,13 @@
       let side = hrSide r
       in  HistoryRecordRep side (moveRep rules side $ hrMove r)
 
+setGameHistory :: [HistoryRecord] -> GameM ()
+setGameHistory history = do
+  checkStatus New
+  modify $ \st -> st {
+              gState = (gState st) {gsHistory = history}
+            }
+
 -- | Number of half-moves done in this game
 gameMoveNumber :: Game -> Int
 gameMoveNumber g =
@@ -114,9 +121,10 @@
   if move `notElem` (map pmMove $ possibleMoves rules side board)
      then throwError NotAllowedMove
      else do
+          st <- gets gState
           let (board', _, _) = applyMove rules side move board
               moveMsg = MoveNotify (opposite side) side (moveRep rules side move) (boardRep board')
-              mbResult = getGameResult rules board' (opposite side)
+              mbResult = getGameResult rules st board' (opposite side)
               messages = case mbResult of
                            Nothing -> [moveMsg]
                            Just result ->
diff --git a/src/Core/Json.hs b/src/Core/Json.hs
--- a/src/Core/Json.hs
+++ b/src/Core/Json.hs
@@ -6,6 +6,7 @@
 import Data.Aeson.Types
 import qualified Data.Text as T
 import Data.Default
+import qualified Data.HashMap.Strict as HM
 import System.Log.Heavy
 
 import Core.Types
@@ -25,6 +26,8 @@
 
 instance ToJSON GameResult
 
+instance FromJSON GameResult
+
 instance ToJSON BoardOrientation
 
 instance ToJSON BoardTopology
@@ -183,6 +186,12 @@
       <*> v .:? "update_cache_max_depth" .!= (aiUpdateCacheMaxDepth def)
       <*> v .:? "update_cache_max_pieces" .!= (aiUpdateCacheMaxPieces def)
 
+instance FromJSON BattleServerConfig where
+  parseJSON = withObject "BattleServerConfig" $ \v -> BattleServerConfig
+    <$> v .:? "enable" .!= bsEnable def
+    <*> v .:? "host" .!= bsHost def
+    <*> v .:? "port" .!= bsPort def
+
 instance FromJSON GeneralConfig where
   parseJSON = withObject "GeneralConfig" $ \v -> GeneralConfig
     <$> v .:? "host" .!= (gcHost def)
@@ -193,6 +202,7 @@
     <*> v .:? "log_path" .!= (gcLogFile def)
     <*> v .:? "log_level" .!= (gcLogLevel def)
     <*> v .:? "ai" .!= (gcAiConfig def)
+    <*> v .:? "battle_server" .!= (gcBattleServerConfig def)
 
 instance FromJSON Level where
   parseJSON (String "debug") = return debug_level
@@ -204,4 +214,8 @@
   parseJSON (String "fatal") = return fatal_level
   parseJSON (String "disable") = return disable_logging
   parseJSON invalid = typeMismatch "logging level" invalid
+
+mergeObjects :: Value -> Value -> Value
+mergeObjects (Object v1) (Object v2) = Object (HM.union v1 v2)
+mergeObjects _ _ = error "not object value"
 
diff --git a/src/Core/Parallel.hs b/src/Core/Parallel.hs
--- a/src/Core/Parallel.hs
+++ b/src/Core/Parallel.hs
@@ -10,27 +10,41 @@
 import Control.Concurrent
 import Data.Maybe
 import qualified Data.Map as M
+import qualified Data.Text as T
 import System.Log.Heavy
 
 import Core.Types
 
-data Processor key input output = Processor (input -> key) (Chan input) (Chan (key, Either Error output))
+data Processor key input output = Processor (input -> key) (Chan (input, Chan (key, Either Error output)))
 
 runProcessor :: Int -> (input -> key) -> (input -> Checkers output) -> Checkers (Processor key input output)
 runProcessor nThreads getKey fn = do
     st <- ask
     inputChan <- liftIO newChan
-    outChan <- liftIO newChan
 
     forM_ [1 .. nThreads] $ \i -> do
-       liftIO $ forkIO $ worker st inputChan outChan i
-    return $ Processor getKey inputChan outChan
+       liftIO $ forkIO $ worker st inputChan i
+    return $ Processor getKey inputChan
   where
-    worker st inChan outChan i = forever $ do
-      input <- readChan inChan
+    worker st inChan i = forever $ do
+      (input, outChan) <- readChan inChan
       output <- runCheckersT (withLogVariable "thread" (i :: Int) $ fn input) st
       writeChan outChan (getKey input, output)
 
+runProcessor' :: [T.Text] -> (input -> key) -> (T.Text -> input -> Checkers output) -> Checkers (Processor key input output)
+runProcessor' labels getKey fn = do
+    st <- ask
+    inputChan <- liftIO newChan
+
+    forM_ labels $ \label -> do
+       liftIO $ forkIO $ worker st inputChan label
+    return $ Processor getKey inputChan
+  where
+    worker st inChan label = forever $ do
+      (input, outChan) <- readChan inChan
+      output <- runCheckersT (withLogVariable "thread" label $ fn label input) st
+      writeChan outChan (getKey input, output)
+
 process :: Ord key => Processor key input output -> [input] -> Checkers [output]
 process processor inputs = do
     results <- process' processor inputs
@@ -39,12 +53,22 @@
       Left err -> throwError err
 
 process' :: Ord key => Processor key input output -> [input] -> Checkers [Either Error output]
-process' (Processor getKey inChan outChan) inputs = do
+process' (Processor getKey inChan) inputs = do
     let n = length inputs
+    outChan <- liftIO newChan
     forM_ inputs $ \input ->
-      liftIO $ writeChan inChan input
+      liftIO $ writeChan inChan (input, outChan)
     results <- replicateM n $ liftIO $ readChan outChan
     let m = M.fromList results
     let results = [fromJust $ M.lookup (getKey input) m | input <- inputs]
     return results
+
+processSingle :: Processor key input output -> input -> Checkers output
+processSingle (Processor _ inChan) input = do
+    outChan <- liftIO newChan
+    liftIO $ writeChan inChan (input, outChan)
+    result <- liftIO $ readChan outChan
+    case snd result of
+      Right output -> return output
+      Left err -> throwError err
 
diff --git a/src/Core/Rest.hs b/src/Core/Rest.hs
deleted file mode 100644
--- a/src/Core/Rest.hs
+++ /dev/null
@@ -1,338 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module Core.Rest where
-
-import           Control.Monad.Reader
-import Control.Concurrent
-import Control.Concurrent.STM
-import Control.Exception as E
-import Control.Monad.Catch
-import Data.String
-import qualified Data.Text                     as T
-import qualified Data.Text.Lazy                as TL
-import           Data.Default
-import           Data.Maybe
-import           Data.Aeson              hiding ( json )
-import           Web.Scotty.Trans
-import qualified Network.HTTP.Types as H
-import           Network.HTTP.Types.Status
-import           Network.Wai.Handler.Warp
-import qualified Network.Wai as Wai
-import           System.Log.Heavy
-import           System.Log.Heavy.TH
-import Network.Socket
-import System.Exit
-
-import           Core.Types
-import           Core.Board
-import           Core.Supervisor
-import           Core.Json                      ( ) -- import instances only
-import           Formats.Types
-import           Formats.Fen
-import           Formats.Pdn
-
-type Rest a = ActionT Error Checkers a
-
-error400 :: T.Text -> Rest ()
-error400 message = do
-  json $ object ["error" .= message]
-  status status400
-
-transformError :: Error -> Rest ()
-transformError (Unhandled err) = do
-  error400 $ T.pack err
-transformError (NoSuchMoveExt move side board possible) = do
-  json $ object [
-      "error" .= ("no such move" :: T.Text),
-      "move" .= move,
-      "side" .= side,
-      "board" .= board,
-      "possible" .= possible
-    ]
-  status status400
-transformError err = do
-  error400 $ T.pack $ show err
-
-raise500 :: Error -> Rest a
-raise500 err = do
-  text $ TL.pack $ show err
-  raiseStatus status500 err
-
-instance Parsable Side where
-  parseParam "1" = Right First
-  parseParam "2" = Right Second
-  parseParam text = Left $ "unknown side"
-
-instance ScottyError Error where
-  stringError str = Unhandled str
-  showError err = TL.pack $ show err
-
-withGameContext :: GameId -> Checkers a -> Checkers a
-withGameContext gameId actions = withLogVariable "game" gameId actions
-
-liftCheckers :: GameId -> Checkers a -> Rest a
-liftCheckers gameId actions = liftCheckers' (Just gameId) actions
-
-liftCheckers_ :: Checkers a -> Rest a
-liftCheckers_ actions = liftCheckers' Nothing actions
-
-liftCheckers' :: Maybe GameId -> Checkers a -> Rest a
-liftCheckers' mbId actions = do
-  res <- lift $ wrap $ tryC actions
-  case res of
-    Right result -> return result
-    Left  err    -> raise500 err
- where
-  wrap r = case mbId of
-    Nothing     -> r
-    Just gameId -> withGameContext gameId r
-
-boardRq :: SupervisorState -> SomeRules -> NewGameRq -> Rest (Maybe Side, Maybe BoardRep)
-boardRq _ _ (NewGameRq { rqBoard = Just br, rqFen = Nothing, rqPdn = Nothing }) =
-  return $ (Nothing, Just br)
-boardRq _ rules (NewGameRq { rqBoard = Nothing, rqFen = Just fen, rqPdn = Nothing })
-  = case parseFen rules fen of
-    Left  err        -> raise $ InvalidBoard err
-    Right (side, br) -> return (Just side, Just br)
-boardRq rnd rules (NewGameRq { rqBoard = Nothing, rqFen = Nothing, rqPdn = Just pdn })
-  = case parsePdn (Just rules) pdn of
-    Left  err -> raise $ InvalidBoard err
-    Right gr  ->
-      case loadPdn rnd gr of
-        Left err -> raise err
-        Right board -> return (Nothing, Just $ boardRep board)
-boardRq _ _ (NewGameRq { rqPrevBoard = Just gameId }) = do
-  board <- liftCheckers_ $ getInitialBoard gameId
-  return (Nothing, Just $ boardRep board)
-boardRq _ _ (NewGameRq { rqBoard = Nothing, rqFen = Nothing, rqPdn = Nothing }) =
-  return (Nothing, Nothing)
-boardRq _ _ _ =
-  raise $ InvalidBoard "only one of fields must be filled: board, fen, pdn"
-
-parsePdnInfo :: PdnInfoRq -> Rest PdnInfo
-parsePdnInfo (PdnInfoRq rname text) = do
-  case selectRules' rname of
-    Nothing -> raise UnknownRules
-    Just rules ->
-      case parsePdn (Just rules) text of
-        Left err -> raise $ InvalidBoard err
-        Right gr -> return $ pdnInfo gr
-
-restServer :: MVar () -> ScottyT Error Checkers ()
-restServer shutdownVar = do
-
-  defaultHandler transformError
-
-  post "/game/new" $ do
-    rq <- jsonData
-    case selectRules rq of
-      Nothing    -> error400 "invalid game rules"
-      Just rules -> do
-        rnd <- liftCheckers_ $ do
-                 sup <- askSupervisor
-                 liftIO $ atomically $ readTVar sup
-        (mbFirstSide, board) <- boardRq rnd rules rq
-        let firstSide = fromMaybe First mbFirstSide
-        gameId <- liftCheckers_ $ newGame rules firstSide board
-        liftCheckers gameId $ $info
-          "Created new game #{}; First turn: {}; initial board: {}"
-          (gameId, show firstSide, show board)
-        json $ Response (NewGameRs gameId firstSide) []
-
-  post "/game/:id/attach/ai/:side" $ do
-    gameId <- param "id"
-    side   <- param "side"
-    rules  <- liftCheckers gameId $ getRules gameId
-    rq     <- jsonData
-    case selectAi rq rules of
-      Nothing -> error400 "invalid ai settings"
-      Just ai -> do
-        liftCheckers gameId $ do
-          $info "Attached AI: {} to game #{} as {}" (show ai, gameId, show side)
-          initAiStorage rules ai
-          attachAi gameId side ai
-        json $ Response AttachAiRs []
-
-  post "/game/:id/attach/:name/:side" $ do
-    gameId <- param "id"
-    name   <- param "name"
-    side   <- param "side"
-    liftCheckers gameId $ do
-      registerUser gameId side name
-      $info "Attached player `{}' to game #{} as {}" (name, gameId, show side)
-    json $ Response RegisterUserRs []
-
-  post "/game/:id/run" $ do
-    gameId <- param "id"
-    liftCheckers gameId $ runGame gameId
-    json $ Response RunGameRs []
-
-  get "/game/:id/state" $ do
-    gameId <- param "id"
-    rs     <- liftCheckers gameId $ getState gameId
-    json $ Response rs []
-
-  get "/game/:id/fen" $ do
-    gameId <- param "id"
-    rs     <- liftCheckers gameId $ getFen gameId
-    Web.Scotty.Trans.text $ TL.fromStrict rs
-
-  get "/game/:id/pdn" $ do
-    gameId <- param "id"
-    rs     <- liftCheckers gameId $ getPdn gameId
-    Web.Scotty.Trans.text $ TL.fromStrict rs
-
-  get "/game/:id/history" $ do
-    gameId <- param "id"
-    rs     <- liftCheckers gameId $ getHistory gameId
-    json $ Response (HistoryRs rs) []
-
-  post "/game/:id/move/:name" $ do
-    gameId   <- param "id"
-    name     <- param "name"
-    moveRq   <- jsonData
-    board    <- liftCheckers gameId $ doMove gameId name moveRq
-    messages <- liftCheckers gameId $ getMessages name
-    json $ Response (MoveRs board) messages
-
-  get "/game/:id/moves/:name" $ do
-    gameId   <- param "id"
-    name     <- param "name"
-    side     <- liftCheckers gameId $ getSideByUser gameId name
-    moves    <- liftCheckers gameId $ getPossibleMoves gameId side
-    messages <- liftCheckers gameId $ getMessages name
-    json $ Response (PossibleMovesRs moves) messages
-
-  post "/game/:id/undo/:name" $ do
-    gameId   <- param "id"
-    name     <- param "name"
-    board    <- liftCheckers gameId $ doUndo gameId name
-    messages <- liftCheckers gameId $ getMessages name
-    json $ Response (UndoRs board) messages
-
-  post "/game/:id/capitulate/:name" $ do
-    gameId <- param "id"
-    name   <- param "name"
-    liftCheckers gameId $ doCapitulate gameId name
-    messages <- liftCheckers gameId $ getMessages name
-    json $ Response CapitulateRs messages
-
-  post "/game/:id/draw/request/:name" $ do
-    gameId <- param "id"
-    name   <- param "name"
-    liftCheckers gameId $ doDrawRequest gameId name
-    messages <- liftCheckers gameId $ getMessages name
-    json $ Response DrawRqRs messages
-
-  post "/game/:id/draw/accept/:name" $ do
-    gameId <- param "id"
-    name   <- param "name"
-    liftCheckers gameId $ doDrawAccept gameId name True
-    messages <- liftCheckers gameId $ getMessages name
-    json $ Response (DrawAcceptRs True) messages
-
-  post "/game/:id/draw/decline/:name" $ do
-    gameId <- param "id"
-    name   <- param "name"
-    liftCheckers gameId $ doDrawAccept gameId name False
-    messages <- liftCheckers gameId $ getMessages name
-    json $ Response (DrawAcceptRs False) messages
-
-  get "/poll/:name" $ do
-    name     <- param "name"
-    messages <- liftCheckers_ $ getMessages name
-    json $ Response (PollRs messages) []
-
-  get "/lobby/:rules" $ do
-    rules <- param "rules"
-    games <- liftCheckers_ $ getGames (Just rules)
-    json $ Response (LobbyRs games) []
-
-  get "/lobby" $ do
-    games <- liftCheckers_ $ getGames Nothing
-    json $ Response (LobbyRs games) []
-
-  get "/notation/:rules" $ do
-    rules                         <- param "rules"
-    (size, orientation, notation) <- liftCheckers_ $ getNotation rules
-    json $ Response (NotationRs size orientation notation) []
-
-  get "/topology/:rules" $ do
-    rules <- param "rules"
-    topology <- liftCheckers_ $ getTopology rules
-    json $ Response (TopologyRs topology) []
-
-  post "/file/info/pdn" $ do
-    rq <- jsonData
-    info <- parsePdnInfo rq
-    json $ Response (PdnInfoRs info) []
-
-  post "/server/shutdown" $ do
-    isLocal <- lift $ asks (gcLocal . csConfig)
-    if isLocal
-      then do
-        json $ Response ShutdownRs []
-        liftIO $ putMVar shutdownVar ()
-      else error400 "Server is not running in local mode"
-
-  get "/status" $ do
-    json $ object [
-        "status" .= ("ready" :: T.Text)
-      ]
-
-restOptions :: String -> Port -> Web.Scotty.Trans.Options
-restOptions host port =
-  Options 0 $ setOnExceptionResponse errorHandler $
-              setHost (fromString host) $
-              setPort port (settings def)
-
-errorHandler :: SomeException -> Wai.Response
-errorHandler e
-  | Just (err :: Error) <- fromException e =
-      Wai.responseLBS H.internalServerError500
-         [(H.hContentType, "text/plain; charset=utf-8")]
-         (fromString $ show err)
-  | otherwise =
-      Wai.responseLBS H.internalServerError500
-         [(H.hContentType, "text/plain; charset=utf-8")]
-         (fromString $ show e)
-
--- openSocket :: AddrInfo -> IO Socket
--- openSocket addr = socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
--- 
--- checkPort :: HostName -> Port -> IO Bool
--- checkPort host port = do
---   addr <- head <$> getAddrInfo (Just defaultHints) (Just host) (Just $ show port)
---   E.bracketOnError (openSocket addr) close $ \sock -> do
---     withFdSocket sock setCloseOnExecIfNeeded
---     r <- E.try $ bind sock $ addrAddress addr
---     case r of
---       Right _ -> return True
---       Left (e :: SomeException) -> do
---         print e
---         return False
-
-ioErrorHandler :: IOError -> Checkers ()
-ioErrorHandler err = liftIO $ do
-  putStrLn $ "IO error: " ++ show err
-  exitWith (ExitFailure 2)
-
-runRestServer :: Checkers ()
-runRestServer = do
-  cs <- ask
-  let getResponse m = do
-        res <- runCheckersT m cs
-        case res of
-          Right response -> return response
-          Left  err      -> fail $ show err
-  host <- asks (T.unpack . gcHost . csConfig)
-  port <- asks (gcPort . csConfig)
-  -- portOpen <- liftIO $ checkPort host port
-  shutdownVar <- liftIO newEmptyMVar
-  forkCheckers $ handleIOError ioErrorHandler $ scottyOptsT (restOptions host (fromIntegral port)) getResponse (restServer shutdownVar)
-  liftIO $ takeMVar shutdownVar
-  -- REST thread should be able to write the response to Shutdown request.
-  liftIO $ threadDelay (1000 * 1000)
-
diff --git a/src/Core/Supervisor.hs b/src/Core/Supervisor.hs
--- a/src/Core/Supervisor.hs
+++ b/src/Core/Supervisor.hs
@@ -21,10 +21,12 @@
 import qualified Data.Map as M
 import qualified Data.Text as T
 import Data.Array.IArray as A
+import qualified Data.ByteString as B
 import Data.Text.Format.Heavy
 import Data.Default
 import Data.Aeson hiding (Error)
 import Data.Dynamic
+import Data.Store
 import GHC.Generics
 import System.Random
 import System.Log.Heavy
@@ -32,6 +34,9 @@
 import System.Log.Heavy.Format
 import System.Log.FastLogger.Date
 import System.Random.MWC
+import System.Environment
+import System.FilePath
+import System.Directory
 
 import Core.Types
 import Core.Board
@@ -102,14 +107,33 @@
   | ShutdownRs
   deriving (Eq, Show, Generic)
 
--- | Create supervisor handle
-mkSupervisor :: IO SupervisorHandle
-mkSupervisor = do
+newRandomTable :: IO RandomTable
+newRandomTable = do
   random <- withSystemRandom . asGenIO $ \gen ->
     forM [1 .. 4] $ \unboxedPiece ->
       forM [1 .. 16*16] $ \index ->
         uniform gen
   let randomArray = A.listArray ((1,0), (4, 16*16-1)) $ concat random
+  return randomArray
+
+loadRandomTable :: IO RandomTable
+loadRandomTable = do
+  home <- getEnv "HOME"
+  let path = home </> ".cache" </> "hcheckers" </> "random.table"
+  ex <- doesFileExist path
+  if ex
+    then do
+      bytes <- B.readFile path
+      Data.Store.decodeIO bytes
+    else do
+      table <- newRandomTable
+      B.writeFile path $ Data.Store.encode table
+      return table
+
+-- | Create supervisor handle
+mkSupervisor :: IO SupervisorHandle
+mkSupervisor = do
+  randomArray <- loadRandomTable
   var <- atomically $ newTVar $ SupervisorState M.empty 0 M.empty $! randomArray
   return var
 
@@ -185,15 +209,26 @@
 initAiStorage :: SomeRules -> SomeAi -> Checkers ()
 initAiStorage (SomeRules rules) (SomeAi ai) = do
   var <- askSupervisor
-  st <- liftIO $ atomically $ readTVar var
   let key = (rulesName rules, aiName ai)
-  case M.lookup key (ssAiStorages st) of
-    Nothing -> do
-      storage <- createAiStorage ai
-      liftIO $ atomically $ modifyTVar var $ \st ->
+  storage <- createAiStorage ai
+
+  liftIO $ atomically $ do
+    st <- readTVar var
+    case M.lookup key (ssAiStorages st) of
+      Nothing -> do
+        modifyTVar var $ \st ->
           st {ssAiStorages = M.insert key (toDyn storage) (ssAiStorages st)}
-    Just _ -> return ()
+      Just _ -> return ()
 
+-- initAiStorage_ :: SomeRules -> SomeAi -> Checkers ()
+-- initAiStorage_ (SomeRules rules) (SomeAi ai) = do
+--   var <- askSupervisor
+--   let key = (rulesName rules, aiName ai)
+--   storage <- createAiStorage ai
+--   liftIO $ atomically $ modifyTVar var $ \st ->
+--           st {ssAiStorages = M.insert key (toDyn storage) (ssAiStorages st)}
+--   return ()
+
 -- | Create a game in the New state
 newGame :: SomeRules -> Side -> Maybe BoardRep -> Checkers GameId
 newGame r@(SomeRules rules) firstSide mbBoardRep = do
@@ -206,6 +241,10 @@
     game <- mkGame st' rules gameId firstSide mbBoardRep
     modifyTVar var $ \st -> st {ssGames = M.insert (show gameId) game (ssGames st)}
     return $ show gameId
+
+setHistory :: GameId -> [HistoryRecord] -> Checkers ()
+setHistory gameId history = 
+  withGame gameId $ \_ -> setGameHistory history
 
 -- | Register a user in the game
 registerUser :: GameId -> Side -> String -> Checkers ()
diff --git a/src/Core/Types.hs b/src/Core/Types.hs
--- a/src/Core/Types.hs
+++ b/src/Core/Types.hs
@@ -17,9 +17,9 @@
 import Control.Monad.Metrics as Metrics
 import Control.Concurrent
 import Control.Concurrent.STM
-import Control.Exception as E (try)
 import Data.List
 import Data.Array.Unboxed
+import Data.Aeson.Types
 import qualified Data.Vector as V
 import qualified Data.Map as M
 import qualified Data.IntMap.Strict as IM
@@ -31,7 +31,6 @@
 import qualified StmContainers.Map as SM
 import Data.Text.Format.Heavy
 import Data.Dynamic
-import Data.Aeson (Value)
 import Data.Int
 import Data.Word
 import Data.Binary
@@ -43,6 +42,7 @@
 import System.Log.Heavy
 import System.Log.Heavy.TH
 import System.Clock
+import Web.Scotty.Trans
 import GHC.Exts (Constraint)
 
 import Debug.Trace (traceEventIO)
@@ -86,6 +86,8 @@
 data PieceKind = Man | King
   deriving (Eq, Ord, Generic, Typeable)
 
+instance Store PieceKind
+
 instance Show PieceKind where
   show Man = "M"
   show King = "K"
@@ -128,8 +130,10 @@
     pieceKind :: PieceKind
   , pieceSide :: Side
   }
-  deriving (Eq, Ord, Typeable)
+  deriving (Eq, Ord, Typeable, Generic)
 
+instance Store Piece
+
 instance Show Piece where
   show (Piece k s) = show k ++ show s
 
@@ -379,8 +383,10 @@
 
 -- | Representation of Board for JSON
 data BoardRep = BoardRep [(Label, Piece)]
-  deriving (Eq, Ord, Show, Typeable)
+  deriving (Eq, Ord, Show, Typeable, Generic)
 
+instance Store BoardRep
+
 boardRepLen :: BoardRep -> Int
 boardRepLen (BoardRep lst) = length lst
 
@@ -435,7 +441,7 @@
   boardTopology :: a -> BoardTopology
 
 -- | Interface of game rules
-class (Typeable g, Show g, HasBoardOrientation g, HasTopology g, VectorEvaluator (EvaluatorForRules g)) => GameRules g where
+class (Typeable g, Show g, HasBoardOrientation g, HasTopology g, VectorEvaluator (EvaluatorForRules g), ToJSON (EvaluatorForRules g)) => GameRules g where
   type EvaluatorForRules g
   -- | Initial board with initial pieces position
   initBoard :: SupervisorState -> g -> Board
@@ -455,10 +461,18 @@
   mobilityScore g side board = length $ possibleMoves g side board
 
   updateRules :: g -> Value -> g
-  getGameResult :: g -> Board -> Side -> Maybe GameResult
+  getGameResult :: g -> GameState -> Board -> Side -> Maybe GameResult
   rulesName :: g -> String
   pdnId :: g -> String
 
+  getBackDirections :: g -> [PlayerDirection]
+  getBackDirections _ = [BackwardLeft, BackwardRight]
+
+  getForwardDirections :: g -> [PlayerDirection]
+  getForwardDirections _ = [ForwardLeft, ForwardRight]
+
+  getAllAddresses :: g -> [Address]
+
 fieldsCount :: GameRules rules => rules -> Line
 fieldsCount rules =
   let (nrows, ncols) = boardSize rules
@@ -565,9 +579,8 @@
   updateEval e _ = e
 
 class Evaluator e => VectorEvaluator e where
-  type VectorEvaluatorSupport e rules :: Constraint
   evalToVector :: e -> V.Vector Double
-  evalFromVector :: VectorEvaluatorSupport e rules => rules -> V.Vector Double -> e
+  evalFromVector :: GameRules rules => rules -> V.Vector Double -> e
 
 data SomeEval = forall e. VectorEvaluator e => SomeEval e
   deriving (Typeable)
@@ -580,7 +593,7 @@
   evaluatorName (SomeEval e) = evaluatorName e
   updateEval (SomeEval e) v = SomeEval (updateEval e v)
 
-class (Show ai, Typeable (AiStorage ai)) => GameAi ai where
+class (Show ai, Typeable (AiStorage ai), ToJSON ai) => GameAi ai where
   type AiStorage ai
 
   createAiStorage :: ai -> Checkers (AiStorage ai)
@@ -747,6 +760,20 @@
         , aiUpdateCacheMaxPieces = 8
       }
 
+data BattleServerConfig = BattleServerConfig {
+    bsEnable :: Bool
+  , bsHost :: T.Text
+  , bsPort :: Int
+  }
+  deriving (Show, Typeable, Generic)
+
+instance Default BattleServerConfig where
+  def = BattleServerConfig {
+            bsEnable = False
+          , bsHost = "localhost"
+          , bsPort = 8865
+        }
+
 data GeneralConfig = GeneralConfig {
     gcHost :: T.Text
   , gcPort :: Int
@@ -756,6 +783,7 @@
   , gcLogFile :: FilePath
   , gcLogLevel :: Level
   , gcAiConfig :: AiConfig
+  , gcBattleServerConfig :: BattleServerConfig
   }
   deriving (Show, Typeable, Generic)
 
@@ -768,7 +796,8 @@
     gcMetricsPort = 8000,
     gcLogFile = "hcheckers.log",
     gcLogLevel = info_level,
-    gcAiConfig = def
+    gcAiConfig = def,
+    gcBattleServerConfig = def
   }
 
 -- | Commonly used data
@@ -810,6 +839,8 @@
 instance MonadFail Checkers where
   fail msg = throwError (Unhandled msg)
 
+type Rest a = ActionT Error Checkers a
+
 runCheckersT :: Checkers a -> CheckersState -> IO (Either Error a)
 runCheckersT actions st = runReaderT (runExceptT $ runCheckers actions) st
 
@@ -917,4 +948,17 @@
         Nothing -> do
             $info "{}: work done, in {} iterations" (label, i)
             return result
+
+chunksOf :: Int -> [a] -> [[a]]
+chunksOf n list
+  | length list <= n = [list]
+  | otherwise =
+      let (first, other) = splitAt n list
+      in  first : chunksOf n other
+
+splitBy :: Int -> [a] -> [[a]]
+splitBy n xs =
+  let nxs = length xs
+      m = (nxs `div` n) + 1
+  in  chunksOf m xs
 
diff --git a/src/Formats/Compact.hs b/src/Formats/Compact.hs
--- a/src/Formats/Compact.hs
+++ b/src/Formats/Compact.hs
@@ -12,7 +12,6 @@
 import qualified Data.Text as T
 import Text.Megaparsec hiding (Label, State)
 import Text.Megaparsec.Char
-import Text.Megaparsec.Error (errorBundlePretty)
 import qualified Data.Text.IO as TIO
 import Text.Printf
 
diff --git a/src/Formats/Fen.hs b/src/Formats/Fen.hs
--- a/src/Formats/Fen.hs
+++ b/src/Formats/Fen.hs
@@ -6,10 +6,8 @@
 
 import Control.Monad.State
 import qualified Data.Text as T
-import Data.Monoid ((<>))
 import Text.Megaparsec hiding (Label)
 import Text.Megaparsec.Char
-import Text.Megaparsec.Error (errorBundlePretty)
 
 import Core.Types
 import Core.Board
diff --git a/src/Formats/Pdn.hs b/src/Formats/Pdn.hs
--- a/src/Formats/Pdn.hs
+++ b/src/Formats/Pdn.hs
@@ -14,7 +14,6 @@
 import qualified Data.Text as T
 import Text.Megaparsec hiding (Label, State)
 import Text.Megaparsec.Char
-import Text.Megaparsec.Error (errorBundlePretty)
 import qualified Data.Text.IO as TIO
 import Text.Printf
 
@@ -301,34 +300,37 @@
       state = execState (forM_ instructions interpret) initState
   in  map M.elems $ M.elems $ isVariants state
 
-loadPdn :: SupervisorState -> GameRecord -> Either Error Board
+loadPdn :: SupervisorState -> GameRecord -> Either Error ([HistoryRecord], Board)
 loadPdn rnd r = do
     let findRules [] = Nothing
         findRules (GameType rules:_) = Just rules
         findRules (_:rest) = findRules rest
 
-        withRules :: SomeRules -> Either Error Board
+        withRules :: SomeRules -> Either Error ([HistoryRecord], Board)
         withRules some@(SomeRules rules) = do
             let board0 = initBoardFromTags rnd some (grTags r)
                 
-                go :: Board -> [MoveRec] -> Either Error Board
-                go board [] = return board
-                go board0 (moveRec : rest) = do
-                  board1 <- case mrFirst moveRec of
-                              Just rec -> do
-                                move1 <- parseMoveRec rules First board0 rec
-                                let (board1,_,_) = applyMove rules First move1 board0
-                                return board1
-                              Nothing -> return board0
+                go :: ([HistoryRecord], Board) -> [MoveRec] -> Either Error ([HistoryRecord], Board)
+                go (history, board) [] = return (history, board)
+                go (history, board0) (moveRec : rest) = do
+                  (records1, board1) <-
+                      case mrFirst moveRec of
+                        Just rec -> do
+                          move1 <- parseMoveRec rules First board0 rec
+                          let (board1,_,_) = applyMove rules First move1 board0
+                              record = HistoryRecord First move1 board0
+                          return ([record], board1)
+                        Nothing -> return ([], board0)
                   case mrSecond moveRec of
-                    Nothing -> return board1
+                    Nothing -> return (records1 ++ history, board1)
                     Just rec -> do
                       move2 <- parseMoveRec rules Second board1 rec
                       let (board2,_,_) = applyMove rules Second move2 board1
-                      go board2 rest
+                          record = HistoryRecord Second move2 board1
+                      go ([record] ++ records1 ++ history, board2) rest
 
             case instructionsToMoves (grMoves r) of
-              [moves] -> go board0 moves
+              [moves] -> go ([], board0) moves
               vars -> Left $ AmbigousPdnInstruction $ show vars
 
     case findRules (grTags r) of
diff --git a/src/Formats/Types.hs b/src/Formats/Types.hs
--- a/src/Formats/Types.hs
+++ b/src/Formats/Types.hs
@@ -11,7 +11,6 @@
 import Data.Typeable
 import Text.Megaparsec hiding (Label, State)
 import Data.Void
-import Data.Aeson
 import GHC.Generics
 
 import Core.Types
diff --git a/src/Learn.hs b/src/Learn.hs
--- a/src/Learn.hs
+++ b/src/Learn.hs
@@ -8,7 +8,6 @@
 import Control.Monad.State
 import Control.Concurrent.STM
 import qualified Control.Monad.Metrics as Metrics
-import Control.Monad.Catch
 import Data.Text.Format.Heavy
 import System.Log.Heavy
 import System.Log.Heavy.TH
@@ -18,7 +17,7 @@
 import AI.AlphaBeta
 import AI.AlphaBeta.Types
 import AI.AlphaBeta.Cache
-import AI.AlphaBeta.Persistent
+-- import AI.AlphaBeta.Persistent
 import Formats.Types
 import Formats.Pdn
 
@@ -29,15 +28,9 @@
     let startBoard = initBoardFromTags supervisor (SomeRules rules) (grTags gameRec)
     let result = resultFromTags $ grTags gameRec
     $info "Initial board: {}; result: {}" (show startBoard, show result)
-    forM_ (instructionsToMoves $ grMoves gameRec) $ \moves -> (do
+    forM_ (instructionsToMoves $ grMoves gameRec) $ \moves -> do
         let (endScore, allBoards) = go [] startBoard result moves
         $info "End score: {}" (Single endScore)
-        runStorage var $ forM_ allBoards $ \board -> do
-          let stats = Stats 1 endScore endScore endScore
-          putStatsFile board stats
-        )
-          `catch`
-            (\(e :: SomeException) -> $reportError "Exception: {}" (Single $ show e))
   where
     go boards lastBoard (Just result) [] = (resultToScore result, lastBoard : boards)
     go boards lastBoard Nothing [] =
@@ -78,9 +71,6 @@
     forM_ (instructionsToMoves $ grMoves gameRec) $ \moves -> do
       (endScore, allBoards) <- go (0, []) startBoard [] moves
       $info "End score: {}" (Single endScore)
-      runStorage var $ forM_ allBoards $ \board -> do
-        let stats = Stats 1 endScore endScore endScore
-        putStatsFile board stats
 
   where
     go (score, boards) lastBoard _ [] = return (score, lastBoard : boards)
@@ -123,7 +113,7 @@
   $info "Processed: side {}, move: {}, depth: {} => score {}; we think next best moves are: {}" (show side, show move, abDepth params, show score, show moves)
   return (moves, score)
 
-learnPdn :: (GameRules rules, Evaluator eval) => AlphaBeta rules eval -> FilePath -> Checkers ()
+learnPdn :: (GameRules rules, VectorEvaluator eval) => AlphaBeta rules eval -> FilePath -> Checkers ()
 learnPdn ai@(AlphaBeta params rules eval) path = do
   cache <- loadAiCache scoreMoveGroup ai
   pdn <- liftIO $ parsePdnFile (Just $ SomeRules rules) path
diff --git a/src/Main.hs b/src/Main.hs
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -6,28 +6,35 @@
 import Control.Monad.Reader
 import Control.Concurrent.STM
 import Data.Default
+import Data.Maybe
+import Data.List
 import qualified Data.Map as M
+import qualified Data.Text as T
+import qualified Data.Text.IO as TIO
 import qualified Data.ByteString.Lazy.Char8 as C8
 import qualified Data.Aeson as Aeson
 import System.Log.Heavy
 import Options.Applicative
 import Text.Printf
+import System.Random
 
-import Core.Types
-import Core.Board
+import Core.Types hiding (timed)
 import AI
 import AI.AlphaBeta.Types
-import AI.AlphaBeta.Persistent
-import Core.Rest
+import AI.AlphaBeta.Persistent (loadAiData')
+import Rest.Common (runRestServer)
+import Rest.Game (restServer)
+import Rest.Battle (restServer)
 import Core.Checkers
 import Core.CmdLine
 import Core.Supervisor (withRules)
-import Core.Evaluator
+import Core.Parallel
+import Core.Monitoring
 
 import Learn
 import Battle
 import Rules.Russian
-import Rules.Spancirety
+-- import Rules.Spancirety
 
   -- let stdout = LoggingSettings $ filtering defaultLogFilter defStdoutSettings
       -- debug = LoggingSettings $ Filtering (\m -> lmLevel m == trace_level) ((defFileSettings "trace.log") {lsFormat = "{time} {source} [{thread}]: {message}\n"})
@@ -39,10 +46,18 @@
   case cmdSpecial cmd of
     Nothing ->
       withCheckers cmd $ do
-          cfg <- asks csConfig
-          let fltr = [([], gcLogLevel cfg)]
-          withLogContext (LogContextFrame [] (include fltr)) $
-              runRestServer
+          logLevel <- asks (gcLogLevel . csConfig)
+          host <- asks (T.unpack . gcHost . csConfig)
+          port <- asks (gcPort . csConfig)
+          bsConfig <- asks (gcBattleServerConfig . csConfig)
+          let fltr = [([], logLevel)]
+          withLogContext (LogContextFrame [] (include fltr)) $ do
+              if fromMaybe False (cmdBattleServer cmd)
+                then if bsEnable bsConfig
+                       then runRestServer (T.unpack $ bsHost bsConfig) (bsPort bsConfig) Rest.Battle.restServer
+                       else fail "Battle server is not enabled in config"
+                else runRestServer host port Rest.Game.restServer
+                
     Just str -> special cmd (words str)
 
 special :: CmdLine -> [String] -> IO ()
@@ -66,9 +81,19 @@
         ai2 <- loadAi "default" rules path2
         withCheckers cmd $
             withLogContext (LogContextFrame [] (include defaultLogFilter)) $ do
-              runBattle (SomeRules rules) (SomeAi ai1) (SomeAi ai2) "battle.pdn"
+              runBattleLocal (SomeRules rules) (1,SomeAi ai1) (2,SomeAi ai2) "battle.pdn"
               return ()
 
+    ["battle-remote", host, rulesName, path1, path2] -> do
+      withRules rulesName $ \rules -> do
+        ai1 <- loadAi "default" rules path1
+        ai2 <- loadAi "default" rules path2
+        withCheckers cmd $
+            withLogContext (LogContextFrame [] (include defaultLogFilter)) $ do
+              rs <- runBattleRemote (T.pack host) (SomeRules rules) (1,SomeAi ai1) (2,SomeAi ai2) "battle.pdn"
+              liftIO $ putStrLn $ "Remote: " ++ show rs
+              return ()
+
     ["match", rulesName, ns, path1, path2] -> do
       withRules rulesName $ \rules -> do
         let n = read ns
@@ -78,7 +103,7 @@
         putStrLn $ "AI2: " ++ show ai2
         withCheckers cmd $
             withLogContext (LogContextFrame [] (include defaultLogFilter)) $ do
-              runMatch (SomeRules rules) (SomeAi ai1) (SomeAi ai2) n
+              runMatch runBattleLocal (SomeRules rules) (1, SomeAi ai1) (2, SomeAi ai2) n
               return ()
 
     ("tournament": matches : games : paths) -> do 
@@ -88,19 +113,14 @@
       ais <- forM paths $ \path -> loadAi "default" rules path
       withCheckers cmd $
           withLogContext (LogContextFrame [] (include defaultLogFilter)) $ do
-            runTournament rules ais nMatches nGames
+            runTournament (dumbMatchRunner runBattleLocal) rules ais nMatches nGames
             return ()
 
-    ("genetics": generations : size : best : paths) -> do
-      let rules = spancirety
-          nGenerations = read generations
-          generationSize = read size
-          nBest = read best
-      ais <- forM paths $ \path -> loadAi "default" rules path
-      withCheckers cmd $
+    ["genetics", yamlPath] -> do
+      withCheckers cmd $ do
           withLogContext (LogContextFrame [] (include defaultLogFilter)) $ do
-            result <- runGenetics rules nGenerations generationSize nBest ais
-            forM_ result $ \ai -> liftIO $ C8.putStrLn $ Aeson.encode ai
+            result <- runGeneticsJ yamlPath
+            forM_ result $ \(SomeAi ai) -> liftIO $ C8.putStrLn $ Aeson.encode ai
             return ()
 
     ["generate", ns, deltas, path] -> do
@@ -108,96 +128,11 @@
           delta = read deltas
       generateAiVariations n delta path
 
-    -- ["dump", path] -> checkDataFile' path
-    ["load", path] -> do
-      idx <- loadIndexIO path
-      print path
-
-    ["test"] -> do
+    ["dump", path] -> do
       withCheckers cmd $ do
         let rules = russian
-            cache = seCache $ defaultEvaluator rules
-        forM_ (M.assocs cache) $ \(addr, sed) -> do
-            liftIO $ printf "%s => %s, %s\n"
-                (show $ aLabel addr)
-                (show $ weightForSide First $ sedCenter sed)
-                (show $ weightForSide Second $ sedCenter sed)
-    
--- main :: IO ()
--- main = do
---   let a3 = resolve "a3" board8
---   let b4 = resolve "b4" board8
---   let c5 = resolve "c5" board8
---   let b6 = resolve "b6" board8
---   let board8' = movePiece' "h8" "b4" $ removePiece' "a7" board8
---   let capture = simpleCapture First a3 ForwardRight
---   putStrLn "1."
---   print capture
--- 
---   putStrLn "2."
---   let (board', addr', p) = applyMove First capture board8'
---   print $ getPiece a3 board'
---   print $ getPiece b4 board'
---   print $ getPiece c5 board'
---   print $ getPiece b6 board'
--- 
---   let capture' = simpleCapture First c5
--- 
---   putStrLn "3."
---   print $
---     let addr = resolve "c5" board'
---         piece = fromJust $ getPiece addr board'
---     in  captures1 piece board' addr
--- 
---   putStrLn "4."
---   print $
---     let addr = resolve "a3" board8'
---         piece = fromJust $ getPiece addr board8'
---     in  manCaptures piece board8' addr
--- 
---   putStrLn "5."
---   print $ possibleMoves Russian First board8'
--- 
---   putStrLn "6."
---   let board8'' = setPiece' "b2" (Piece King First) $
---                  setManyPieces' ["d4", "d6", "g7"] (Piece Man Second) $ buildBoard 8
---   print $ kingSimpleMoves First board8'' (resolve "b2" board8'')
--- 
---   putStrLn "7."
---   print $ possibleMoves Russian First board8''
--- 
---   putStrLn "8."
---   let board = board8''
---   let moves = possibleMoves Russian Second board
---   forM_ moves $ \move -> do
---     print move
---     let (board', addr', _) = applyMove Second move board
---         moves' = possibleMoves Russian Second board'
---     let score1 = evalBoard Russian First board'
---         score2 = evalBoard Russian Second board'
---     putStrLn $ show score1 ++ " vs " ++ show score2
--- 
---   putStrLn "9."
---   let board = movePiece' "e3" "f4" board8
---   let moves = possibleMoves Russian Second board
---   forM_ moves $ \move -> do
---     let (board', addr', _) = applyMove Second move board
---         moves' = possibleMoves Russian Second board'
---     let score1 = evalBoard Russian First board'
---         score2 = evalBoard Russian Second board'
---     putStrLn $ show move ++ " => " ++ show score1 ++ " vs " ++ show score2
--- 
---   putStrLn "10."
---   let board = setManyPieces' ["c3", "e3"] (Piece Man First) $ 
---               setManyPieces' ["e5", "f6"] (Piece Man Second) $ buildBoard 8
---   let ai = AlphaBeta 2 Russian Russian
---   print =<< chooseMove ai Second board
--- 
--- 
---   putStrLn "11."
---   let board = setManyPieces' ["c3", "e3"] (Piece Man First) $ 
---               setManyPieces' ["e5", "f6"] (Piece Man Second) $ buildBoard 8
---   let ai = AlphaBeta 2 Russian Russian
---   print =<< chooseMove ai First board
--- 
--- 
+        (vec, bmap) <- loadAiData' path
+        liftIO $ printf "Evaluator: %s\n" (show vec)
+        forM_ (M.assocs bmap) $ \(bHash, item) -> do
+            liftIO $ printf "Hash: %d => %s\n" bHash (show item)
+
diff --git a/src/Rest/Battle.hs b/src/Rest/Battle.hs
new file mode 100644
--- /dev/null
+++ b/src/Rest/Battle.hs
@@ -0,0 +1,51 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE DataKinds #-}
+
+module Rest.Battle where
+
+import Control.Monad.Reader
+import Control.Concurrent
+import qualified Data.Text as T
+import Data.Aeson hiding ( json )
+import Web.Scotty.Trans
+import Network.HTTP.Req
+import Text.URI (mkURI)
+
+import Core.Types
+import Core.Json ( ) -- import instances only
+import Core.Supervisor (selectRules')
+
+import Battle (BattleRunner, runBattleLocal)
+import AI (parseAi)
+import Rest.Common
+
+withRulesR :: String -> (forall rules. GameRules rules => rules -> Rest a) -> Rest a
+withRulesR rname fn =
+  case selectRules' rname of
+    Just (SomeRules rules) -> fn rules
+    Nothing -> raise UnknownRules
+
+restServer :: MVar () -> ScottyT Error Checkers ()
+restServer shutdownVar = do
+  
+  post "/battle/run" $ do
+    rq <- jsonData
+    withRulesR (brqRules rq) $ \rules -> do
+      let ab1 = parseAi rules (brqAi1 rq)
+          ab2 = parseAi rules (brqAi2 rq)
+          ai1 = SomeAi ab1
+          ai2 = SomeAi ab2
+      result <- liftCheckers_ $ runBattleLocal (SomeRules rules) (1,ai1) (2,ai2) "battle.pdn"
+      json result
+
+  post "/server/shutdown" $ do
+    isLocal <- lift $ asks (gcLocal . csConfig)
+    if isLocal
+      then do
+        json $ object ["shutdown" .= ("ok" :: T.Text)]
+        liftIO $ putMVar shutdownVar ()
+      else error400 "Server is not running in local mode"
+
diff --git a/src/Rest/Common.hs b/src/Rest/Common.hs
new file mode 100644
--- /dev/null
+++ b/src/Rest/Common.hs
@@ -0,0 +1,139 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Rest.Common where
+
+import Control.Monad.Reader
+import Control.Concurrent
+import Control.Exception as E
+import Control.Monad.Catch
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
+import Data.Default
+import Data.Aeson hiding (json)
+import Data.String
+import System.Log.Heavy
+import Web.Scotty.Trans
+import Network.HTTP.Types.Status
+import qualified Network.HTTP.Types as H
+import qualified Network.Wai as Wai
+import Network.Wai.Handler.Warp
+import System.Exit
+
+import Core.Types
+import Core.Json () -- import instances only
+
+withGameContext :: GameId -> Checkers a -> Checkers a
+withGameContext gameId actions = withLogVariable "game" gameId actions
+
+liftCheckers :: GameId -> Checkers a -> Rest a
+liftCheckers gameId actions = liftCheckers' (Just gameId) actions
+
+liftCheckers_ :: Checkers a -> Rest a
+liftCheckers_ actions = liftCheckers' Nothing actions
+
+liftCheckers' :: Maybe GameId -> Checkers a -> Rest a
+liftCheckers' mbId actions = do
+  res <- lift $ wrap $ tryC actions
+  case res of
+    Right result -> return result
+    Left  err    -> raise500 err
+ where
+  wrap r = case mbId of
+    Nothing     -> r
+    Just gameId -> withGameContext gameId r
+
+raise500 :: Error -> Rest a
+raise500 err = do
+  text $ TL.pack $ show err
+  raiseStatus status500 err
+
+error400 :: T.Text -> Rest ()
+error400 message = do
+  json $ object ["error" .= message]
+  status status400
+
+transformError :: Error -> Rest ()
+transformError (Unhandled err) = do
+  error400 $ T.pack err
+transformError (NoSuchMoveExt move side board possible) = do
+  json $ object [
+      "error" .= ("no such move" :: T.Text),
+      "move" .= move,
+      "side" .= side,
+      "board" .= board,
+      "possible" .= possible
+    ]
+  status status400
+transformError (InvalidGameStatus expected actual) = do
+  json $ object [
+      "error" .= ("invalid game status" :: T.Text),
+      "expected" .= expected,
+      "actual" .= actual
+    ]
+transformError err = do
+  error400 $ T.pack $ show err
+
+instance Parsable Side where
+  parseParam "1" = Right First
+  parseParam "2" = Right Second
+  parseParam text = Left $ "unknown side"
+
+instance ScottyError Error where
+  stringError str = Unhandled str
+  showError err = TL.pack $ show err
+
+restOptions :: String -> Port -> Web.Scotty.Trans.Options
+restOptions host port =
+  Options 0 $ setOnExceptionResponse errorHandler $
+              setHost (fromString host) $
+              setPort port (settings def)
+
+errorHandler :: SomeException -> Wai.Response
+errorHandler e
+  | Just (err :: Error) <- fromException e =
+      Wai.responseLBS H.internalServerError500
+         [(H.hContentType, "text/plain; charset=utf-8")]
+         (fromString $ show err)
+  | otherwise =
+      Wai.responseLBS H.internalServerError500
+         [(H.hContentType, "text/plain; charset=utf-8")]
+         (fromString $ show e)
+
+ioErrorHandler :: IOError -> Checkers ()
+ioErrorHandler err = liftIO $ do
+  putStrLn $ "IO error: " ++ show err
+  exitWith (ExitFailure 2)
+
+runRestServer :: String -> Int -> (MVar () -> ScottyT Error Checkers ()) -> Checkers ()
+runRestServer host port restServer = do
+  cs <- ask
+  let getResponse m = do
+        res <- runCheckersT m cs
+        case res of
+          Right response -> return response
+          Left  err      -> fail $ show err
+  -- portOpen <- liftIO $ checkPort host port
+  shutdownVar <- liftIO newEmptyMVar
+  forkCheckers $ handleIOError ioErrorHandler $ scottyOptsT (restOptions host (fromIntegral port)) getResponse (restServer shutdownVar)
+  liftIO $ takeMVar shutdownVar
+  -- REST thread should be able to write the response to Shutdown request.
+  liftIO $ threadDelay (1000 * 1000)
+
+data BattleRq = BattleRq {
+      brqRules :: String
+    , brqAi1 :: Value
+    , brqAi2 :: Value
+    }
+
+instance ToJSON BattleRq where
+  toJSON rq =
+    object ["rules" .= brqRules rq, "ai1" .= brqAi1 rq, "ai2" .= brqAi2 rq]
+
+instance FromJSON BattleRq where
+  parseJSON (Object v) = BattleRq
+    <$> v .: "rules"
+    <*> v .: "ai1"
+    <*> v .: "ai2"
+
diff --git a/src/Rest/Game.hs b/src/Rest/Game.hs
new file mode 100644
--- /dev/null
+++ b/src/Rest/Game.hs
@@ -0,0 +1,235 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Rest.Game where
+
+import Control.Monad.Reader
+import Control.Concurrent
+import Control.Concurrent.STM
+import qualified Data.Text                     as T
+import qualified Data.Text.Lazy                as TL
+import           Data.Maybe
+import           Data.Aeson              hiding ( json )
+import           Web.Scotty.Trans
+import           System.Log.Heavy
+import           System.Log.Heavy.TH
+
+import           Core.Types
+import           Core.Board
+import           Core.Supervisor
+import           Core.Json                      ( ) -- import instances only
+import           Formats.Types
+import           Formats.Fen
+import           Formats.Pdn
+import Rest.Common
+
+boardRq :: SupervisorState -> SomeRules -> NewGameRq -> Rest (Maybe Side, [HistoryRecord], Maybe BoardRep)
+boardRq _ _ (NewGameRq { rqBoard = Just br, rqFen = Nothing, rqPdn = Nothing }) =
+  return $ (Nothing, [], Just br)
+boardRq _ rules (NewGameRq { rqBoard = Nothing, rqFen = Just fen, rqPdn = Nothing })
+  = case parseFen rules fen of
+    Left  err        -> raise $ InvalidBoard err
+    Right (side, br) -> return (Just side, [], Just br)
+boardRq rnd rules (NewGameRq { rqBoard = Nothing, rqFen = Nothing, rqPdn = Just pdn })
+  = case parsePdn (Just rules) pdn of
+    Left  err -> raise $ InvalidBoard err
+    Right gr  ->
+      case loadPdn rnd gr of
+        Left err -> raise err
+        Right (history, board) -> return (Nothing, history, Just $ boardRep board)
+boardRq _ _ (NewGameRq { rqPrevBoard = Just gameId }) = do
+  board <- liftCheckers_ $ getInitialBoard gameId
+  return (Nothing, [], Just $ boardRep board)
+boardRq _ _ (NewGameRq { rqBoard = Nothing, rqFen = Nothing, rqPdn = Nothing }) =
+  return (Nothing, [], Nothing)
+boardRq _ _ _ =
+  raise $ InvalidBoard "only one of fields must be filled: board, fen, pdn"
+
+parsePdnInfo :: PdnInfoRq -> Rest PdnInfo
+parsePdnInfo (PdnInfoRq rname text) = do
+  case selectRules' rname of
+    Nothing -> raise UnknownRules
+    Just rules ->
+      case parsePdn (Just rules) text of
+        Left err -> raise $ InvalidBoard err
+        Right gr -> return $ pdnInfo gr
+
+restServer :: MVar () -> ScottyT Error Checkers ()
+restServer shutdownVar = do
+
+  defaultHandler transformError
+
+  post "/game/new" $ do
+    rq <- jsonData
+    case selectRules rq of
+      Nothing    -> error400 "invalid game rules"
+      Just rules -> do
+        rnd <- liftCheckers_ $ do
+                 sup <- askSupervisor
+                 liftIO $ atomically $ readTVar sup
+        (mbFirstSide, history, board) <- boardRq rnd rules rq
+        let firstSide = fromMaybe First mbFirstSide
+        gameId <- liftCheckers_ $ newGame rules firstSide board
+        liftCheckers_ $ setHistory gameId history
+        liftCheckers gameId $ $info
+          "Created new game #{}; First turn: {}; initial board: {}"
+          (gameId, show firstSide, show board)
+        json $ Response (NewGameRs gameId firstSide) []
+
+  post "/game/:id/attach/ai/:side" $ do
+    gameId <- param "id"
+    side   <- param "side"
+    rules  <- liftCheckers gameId $ getRules gameId
+    rq     <- jsonData
+    case selectAi rq rules of
+      Nothing -> error400 "invalid ai settings"
+      Just ai -> do
+        liftCheckers gameId $ do
+          $info "Attached AI: {} to game #{} as {}" (show ai, gameId, show side)
+          initAiStorage rules ai
+          attachAi gameId side ai
+        json $ Response AttachAiRs []
+
+  post "/game/:id/attach/:name/:side" $ do
+    gameId <- param "id"
+    name   <- param "name"
+    side   <- param "side"
+    liftCheckers gameId $ do
+      registerUser gameId side name
+      $info "Attached player `{}' to game #{} as {}" (name, gameId, show side)
+    json $ Response RegisterUserRs []
+
+  post "/game/:id/run" $ do
+    gameId <- param "id"
+    liftCheckers gameId $ runGame gameId
+    json $ Response RunGameRs []
+
+  get "/game/:id/state" $ do
+    gameId <- param "id"
+    rs     <- liftCheckers gameId $ getState gameId
+    json $ Response rs []
+
+  get "/game/:id/fen" $ do
+    gameId <- param "id"
+    rs     <- liftCheckers gameId $ getFen gameId
+    Web.Scotty.Trans.text $ TL.fromStrict rs
+
+  get "/game/:id/pdn" $ do
+    gameId <- param "id"
+    rs     <- liftCheckers gameId $ getPdn gameId
+    Web.Scotty.Trans.text $ TL.fromStrict rs
+
+  get "/game/:id/history" $ do
+    gameId <- param "id"
+    rs     <- liftCheckers gameId $ getHistory gameId
+    json $ Response (HistoryRs rs) []
+
+  post "/game/:id/move/:name" $ do
+    gameId   <- param "id"
+    name     <- param "name"
+    moveRq   <- jsonData
+    board    <- liftCheckers gameId $ doMove gameId name moveRq
+    messages <- liftCheckers gameId $ getMessages name
+    json $ Response (MoveRs board) messages
+
+  get "/game/:id/moves/:name" $ do
+    gameId   <- param "id"
+    name     <- param "name"
+    side     <- liftCheckers gameId $ getSideByUser gameId name
+    moves    <- liftCheckers gameId $ getPossibleMoves gameId side
+    messages <- liftCheckers gameId $ getMessages name
+    json $ Response (PossibleMovesRs moves) messages
+
+  post "/game/:id/undo/:name" $ do
+    gameId   <- param "id"
+    name     <- param "name"
+    board    <- liftCheckers gameId $ doUndo gameId name
+    messages <- liftCheckers gameId $ getMessages name
+    json $ Response (UndoRs board) messages
+
+  post "/game/:id/capitulate/:name" $ do
+    gameId <- param "id"
+    name   <- param "name"
+    liftCheckers gameId $ doCapitulate gameId name
+    messages <- liftCheckers gameId $ getMessages name
+    json $ Response CapitulateRs messages
+
+  post "/game/:id/draw/request/:name" $ do
+    gameId <- param "id"
+    name   <- param "name"
+    liftCheckers gameId $ doDrawRequest gameId name
+    messages <- liftCheckers gameId $ getMessages name
+    json $ Response DrawRqRs messages
+
+  post "/game/:id/draw/accept/:name" $ do
+    gameId <- param "id"
+    name   <- param "name"
+    liftCheckers gameId $ doDrawAccept gameId name True
+    messages <- liftCheckers gameId $ getMessages name
+    json $ Response (DrawAcceptRs True) messages
+
+  post "/game/:id/draw/decline/:name" $ do
+    gameId <- param "id"
+    name   <- param "name"
+    liftCheckers gameId $ doDrawAccept gameId name False
+    messages <- liftCheckers gameId $ getMessages name
+    json $ Response (DrawAcceptRs False) messages
+
+  get "/poll/:name" $ do
+    name     <- param "name"
+    messages <- liftCheckers_ $ getMessages name
+    json $ Response (PollRs messages) []
+
+  get "/lobby/:rules" $ do
+    rules <- param "rules"
+    games <- liftCheckers_ $ getGames (Just rules)
+    json $ Response (LobbyRs games) []
+
+  get "/lobby" $ do
+    games <- liftCheckers_ $ getGames Nothing
+    json $ Response (LobbyRs games) []
+
+  get "/notation/:rules" $ do
+    rules                         <- param "rules"
+    (size, orientation, notation) <- liftCheckers_ $ getNotation rules
+    json $ Response (NotationRs size orientation notation) []
+
+  get "/topology/:rules" $ do
+    rules <- param "rules"
+    topology <- liftCheckers_ $ getTopology rules
+    json $ Response (TopologyRs topology) []
+
+  post "/file/info/pdn" $ do
+    rq <- jsonData
+    info <- parsePdnInfo rq
+    json $ Response (PdnInfoRs info) []
+
+  post "/server/shutdown" $ do
+    isLocal <- lift $ asks (gcLocal . csConfig)
+    if isLocal
+      then do
+        json $ Response ShutdownRs []
+        liftIO $ putMVar shutdownVar ()
+      else error400 "Server is not running in local mode"
+
+  get "/status" $ do
+    json $ object [
+        "status" .= ("ready" :: T.Text)
+      ]
+
+-- openSocket :: AddrInfo -> IO Socket
+-- openSocket addr = socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
+-- 
+-- checkPort :: HostName -> Port -> IO Bool
+-- checkPort host port = do
+--   addr <- head <$> getAddrInfo (Just defaultHints) (Just host) (Just $ show port)
+--   E.bracketOnError (openSocket addr) close $ \sock -> do
+--     withFdSocket sock setCloseOnExecIfNeeded
+--     r <- E.try $ bind sock $ addrAddress addr
+--     case r of
+--       Right _ -> return True
+--       Left (e :: SomeException) -> do
+--         print e
+--         return False
+
diff --git a/src/Rules/Armenian.hs b/src/Rules/Armenian.hs
--- a/src/Rules/Armenian.hs
+++ b/src/Rules/Armenian.hs
@@ -23,11 +23,6 @@
 instance HasTopology Armenian where
   boardTopology _ = DiagonalAndOrthogonal
 
-instance SimpleEvaluatorSupport Armenian where
-  getBackDirections _ = [Backward]
-  getForwardDirections _ = [ForwardLeft, Forward, ForwardRight]
-  getAllAddresses r = addresses8 r
-
 instance GameRules Armenian where
   type EvaluatorForRules Armenian = SimpleEvaluator
 
@@ -65,6 +60,10 @@
   getGameResult = genericGameResult
 
   pdnId _ = "44"
+
+  getBackDirections _ = [Backward]
+  getForwardDirections _ = [ForwardLeft, Forward, ForwardRight]
+  getAllAddresses r = addresses8 r
 
 armenianBase :: GenericRules -> GenericRules
 armenianBase =
diff --git a/src/Rules/Brazilian.hs b/src/Rules/Brazilian.hs
--- a/src/Rules/Brazilian.hs
+++ b/src/Rules/Brazilian.hs
@@ -19,9 +19,6 @@
 instance HasTopology Brazilian where
   boardTopology _ = Diagonal
 
-instance SimpleEvaluatorSupport Brazilian where
-  getAllAddresses r = addresses8 r
-
 instance Show Brazilian where
   show = rulesName
 
@@ -49,6 +46,7 @@
   mobilityScore (Brazilian rules) side board = gMobilityScore rules side board
 
   getGameResult = genericGameResult
+  getAllAddresses r = addresses8 r
 
 brazilian :: Brazilian
 brazilian = Brazilian $
diff --git a/src/Rules/Canadian.hs b/src/Rules/Canadian.hs
--- a/src/Rules/Canadian.hs
+++ b/src/Rules/Canadian.hs
@@ -21,9 +21,6 @@
 instance HasTopology Canadian where
   boardTopology _ = Diagonal
 
-instance SimpleEvaluatorSupport Canadian where
-  getAllAddresses r = addresses12 r
-
 instance GameRules Canadian where
   type EvaluatorForRules Canadian = SimpleEvaluator
 
@@ -63,6 +60,7 @@
 
   possibleMoves (Canadian rules) side board = gPossibleMoves rules side board
   mobilityScore (Canadian rules) side board = gMobilityScore rules side board
+  getAllAddresses r = addresses12 r
 
 canadian :: Canadian
 canadian = Canadian $
diff --git a/src/Rules/Czech.hs b/src/Rules/Czech.hs
--- a/src/Rules/Czech.hs
+++ b/src/Rules/Czech.hs
@@ -21,9 +21,6 @@
 instance HasTopology Czech where
   boardTopology _ = Core.Types.Diagonal
 
-instance SimpleEvaluatorSupport Czech where
-  getAllAddresses r = addresses8 r
-
 instance GameRules Czech where
   type EvaluatorForRules Czech = SimpleEvaluator
   pdnId _ = "29"
@@ -47,6 +44,7 @@
   updateRules r _ = r
 
   getGameResult = genericGameResult
+  getAllAddresses r = addresses8 r
 
 manCaptures :: GenericRules -> CaptureState -> [PossibleMove]
 manCaptures rules ct@(CaptureState {..}) =
diff --git a/src/Rules/Diagonal.hs b/src/Rules/Diagonal.hs
--- a/src/Rules/Diagonal.hs
+++ b/src/Rules/Diagonal.hs
@@ -21,9 +21,6 @@
 instance HasTopology DiagonalRussian where
   boardTopology _ = Core.Types.Diagonal
 
-instance SimpleEvaluatorSupport DiagonalRussian where
-  getAllAddresses r = addresses8 r
-
 instance GameRules DiagonalRussian where
   type EvaluatorForRules DiagonalRussian = SimpleEvaluator
   initBoard rnd r =
@@ -62,6 +59,7 @@
   getGameResult = genericGameResult
 
   pdnId _ = "42"
+  getAllAddresses r = addresses8 r
 
 diagonal :: DiagonalRussian
 diagonal = DiagonalRussian $
diff --git a/src/Rules/English.hs b/src/Rules/English.hs
--- a/src/Rules/English.hs
+++ b/src/Rules/English.hs
@@ -23,9 +23,6 @@
 instance HasTopology English where
   boardTopology _ = Diagonal
 
-instance SimpleEvaluatorSupport English where
-  getAllAddresses r = addresses8' r
-
 instance GameRules English where
   type EvaluatorForRules English = SimpleEvaluator
   boardSize _ = boardSize Russian.russian
@@ -51,6 +48,7 @@
   mobilityScore (English rules) side board = gMobilityScore rules side board
 
   pdnId _ = "21"
+  getAllAddresses r = addresses8' r
 
 english :: English
 english = English $
diff --git a/src/Rules/International.hs b/src/Rules/International.hs
--- a/src/Rules/International.hs
+++ b/src/Rules/International.hs
@@ -24,9 +24,6 @@
 instance HasTopology International where
   boardTopology _ = Diagonal
 
-instance SimpleEvaluatorSupport International where
-  getAllAddresses r = addresses10 r
-
 instance GameRules International where
   type EvaluatorForRules International = SimpleEvaluator
   boardSize _ = (10, 10)
@@ -63,6 +60,7 @@
   mobilityScore (International rules) side board = gMobilityScore rules side board
 
   pdnId _ = "20"
+  getAllAddresses r = addresses10 r
 
 internationalBase :: GenericRules -> GenericRules
 internationalBase =
diff --git a/src/Rules/Russian.hs b/src/Rules/Russian.hs
--- a/src/Rules/Russian.hs
+++ b/src/Rules/Russian.hs
@@ -21,9 +21,6 @@
 instance Show Russian where
   show = rulesName
 
-instance SimpleEvaluatorSupport Russian where
-  getAllAddresses r = addresses8 r
-
 instance HasTopology Russian where
   boardTopology _ = Diagonal
 
@@ -51,6 +48,7 @@
   getGameResult = genericGameResult
 
   pdnId _ = "25"
+  getAllAddresses r = addresses8 r
 
 russianBase :: GenericRules -> GenericRules
 russianBase =
diff --git a/src/Rules/Simple.hs b/src/Rules/Simple.hs
--- a/src/Rules/Simple.hs
+++ b/src/Rules/Simple.hs
@@ -19,9 +19,6 @@
 instance Show Simple where
   show = rulesName
 
-instance SimpleEvaluatorSupport Simple where
-  getAllAddresses r = addresses8 r
-
 instance HasTopology Simple where
   boardTopology _ = Diagonal
 
@@ -47,6 +44,7 @@
   mobilityScore (Simple rules) side board = gMobilityScore rules side board
 
   pdnId _ = "43"
+  getAllAddresses r = addresses8 r
 
 simple :: Simple
 simple = Simple $
diff --git a/src/Rules/Spancirety.hs b/src/Rules/Spancirety.hs
--- a/src/Rules/Spancirety.hs
+++ b/src/Rules/Spancirety.hs
@@ -22,9 +22,6 @@
 instance HasTopology Spancirety where
   boardTopology _ = Diagonal
 
-instance SimpleEvaluatorSupport Spancirety where
-  getAllAddresses r = IM.elems $ bAddresses $ buildBoard DummyRandomTableProvider r FirstAtBottom (8, 10)
-
 instance GameRules Spancirety where
   type EvaluatorForRules Spancirety = SimpleEvaluator
   initBoard rnd r =
@@ -57,6 +54,7 @@
   getGameResult = genericGameResult
 
   pdnId _ = "41"
+  getAllAddresses r = IM.elems $ bAddresses $ buildBoard DummyRandomTableProvider r FirstAtBottom (8, 10)
 
 spancirety :: Spancirety
 spancirety = Spancirety $
diff --git a/src/Rules/Turkish.hs b/src/Rules/Turkish.hs
--- a/src/Rules/Turkish.hs
+++ b/src/Rules/Turkish.hs
@@ -24,10 +24,6 @@
 instance HasTopology Turkish where
   boardTopology _ = Orthogonal
 
-instance SimpleEvaluatorSupport Turkish where
-  getBackDirections _ = [Backward]
-  getAllAddresses r = addresses8 r
-
 instance GameRules Turkish where
   type EvaluatorForRules Turkish = SimpleEvaluator
   initBoard rnd r =
@@ -57,6 +53,9 @@
   getGameResult = genericGameResult
 
   pdnId _ = "43"
+
+  getBackDirections _ = [Backward]
+  getAllAddresses r = addresses8 r
 
 turkishBase :: GenericRules -> GenericRules
 turkishBase =