From 2862d8a62684f81ff681c28bdec3e471e727857d Mon Sep 17 00:00:00 2001
From: Denis Tereshkin <denis@kasan.ws>
Date: Mon, 24 Oct 2016 16:39:22 +0700
Subject: [PATCH] HistoryServer: start/stop

---
 mds.cabal                       |  1 +
 src/ATrade/MDS/Database.hs      |  8 ++------
 src/ATrade/MDS/HistoryServer.hs | 16 ++++++++++++++--
 3 files changed, 17 insertions(+), 8 deletions(-)

diff --git a/mds.cabal b/mds.cabal
index 49139e3..886d5db 100644
--- a/mds.cabal
+++ b/mds.cabal
@@ -16,6 +16,7 @@ cabal-version:       >=1.10
 library
   hs-source-dirs:      src
   exposed-modules:     ATrade.MDS.Database
+                     , ATrade.MDS.HistoryServer
   build-depends:       base >= 4.7 && < 5
                      , HDBC
                      , HDBC-postgresql
diff --git a/src/ATrade/MDS/Database.hs b/src/ATrade/MDS/Database.hs
index 97afb9e..9a2ebc6 100644
--- a/src/ATrade/MDS/Database.hs
+++ b/src/ATrade/MDS/Database.hs
@@ -121,10 +121,6 @@ doPutData cmdVar respVar tickerId timeInterval timeframe bars = do
   resp <- takeMVar respVar
   case resp of
     DBOk -> return ()
-    DBError err -> do
-      warningM "DB.Client" $ "Error while calling putData: " ++ show err
-      return ()
-    _ -> do
-      warningM "DB.Client" "Unexpected response"
-      return ()
+    DBError err -> warningM "DB.Client" $ "Error while calling putData: " ++ show err
+    _ -> warningM "DB.Client" "Unexpected response"
 
diff --git a/src/ATrade/MDS/HistoryServer.hs b/src/ATrade/MDS/HistoryServer.hs
index 37e925c..ba74067 100644
--- a/src/ATrade/MDS/HistoryServer.hs
+++ b/src/ATrade/MDS/HistoryServer.hs
@@ -1,14 +1,26 @@
 
 module ATrade.MDS.HistoryServer (
+  startHistoryServer,
+  stopHistoryServer
 ) where
 
 import System.ZMQ4
 import ATrade.MDS.Database
 import Control.Concurrent
 
-data HistoryServer = HistoryServer ThreadId
-}
+data HistoryServer = HistoryServer (MVar ()) (MVar ()) ThreadId
 
 startHistoryServer :: DatabaseInterface -> Context -> IO HistoryServer
 startHistoryServer db ctx = do
+  sock <- socket ctx Router
+  killMv <- newEmptyMVar
+  compMv <- newEmptyMVar
+  tid <- forkFinally (serverThread sock killMv compMv) (cleanup sock killMv compMv)
+  return $ HistoryServer killMv compMv tid
+  where
+    serverThread sock killMv compMv = undefined
+    cleanup sock killMv compMv = undefined
+
+stopHistoryServer :: HistoryServer -> IO ()
+stopHistoryServer (HistoryServer killMv compMv tid) = putMVar killMv () >> killThread tid >> readMVar compMv