Adjust to libatrade-0.10

src/ATrade/Driver/Real/BrokerClientThread.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections     #-}
 
 module ATrade.Driver.Real.BrokerClientThread (
   startBrokerClientThread,
@@ -27,47 +28,58 @@ import           Data.Time.Clock
 import           System.Log.Logger
 import           System.ZMQ4                    hiding (Event)
 
-data BrokerCommand = BrokerSubmitOrder Order | BrokerCancelOrder Integer | BrokerRequestNotifications
+data BrokerCommand = BrokerSubmitOrder Order | BrokerCancelOrder Integer | BrokerRequestNotifications | BrokerHandleNotification Notification
 
-
+startBrokerClientThread :: T.Text -> Context -> T.Text -> T.Text -> BoundedChan BrokerCommand -> BoundedChan Event -> MVar a -> IO ThreadId
-startBrokerClientThread :: T.Text -> Context -> T.Text -> BoundedChan BrokerCommand -> BoundedChan Event -> MVar a -> IO ThreadId
+startBrokerClientThread instId ctx brEp notifEp ordersChan eventChan shutdownVar = do
-startBrokerClientThread instId ctx brEp ordersChan eventChan shutdownVar = forkIO $ whileM_ (isNothing <$> tryReadMVar shutdownVar) $
+  let callback = writeChan ordersChan . BrokerHandleNotification
-  bracket (startBrokerClient (encodeUtf8 instId) ctx brEp defaultClientSecurityParams)
+  forkIO $ whileM_ (isNothing <$> tryReadMVar shutdownVar) $
-    (\bro -> do
+    bracket (startBrokerClient (encodeUtf8 instId) ctx brEp notifEp [callback] defaultClientSecurityParams)
-      stopBrokerClient bro
+      (\bro -> do
-      debugM "Strategy" "Broker client: stop")
+        stopBrokerClient bro
-    (\bs -> handle (\e -> do
+        debugM "Strategy" "Broker client: stop")
-      warningM "Strategy" $ "Broker client: exception: " ++ show (e :: SomeException)
+      (\bs -> handle (\e -> do
-      throwIO e) $ do
+        warningM "Strategy" $ "Broker client: exception: " ++ show (e :: SomeException)
-        now <- getCurrentTime
+        throwIO e) $ do
-        lastNotificationTime <- newIORef now
+          now <- getCurrentTime
-        whileM_ (andM [notTimeout lastNotificationTime, isNothing <$> tryReadMVar shutdownVar]) $ do
+          lastNotificationTime <- newIORef now
-          brokerCommand <- readChan ordersChan
+          lastKnownSqnum <- newIORef 0
-          case brokerCommand of
+          whileM_ (andM [notTimeout lastNotificationTime, isNothing <$> tryReadMVar shutdownVar]) $ do
-            BrokerSubmitOrder order -> do
+            brokerCommand <- readChan ordersChan
-              debugM "Strategy" $ "Submitting order: " ++ show order
+            case brokerCommand of
-              maybeOid <- submitOrder bs order
+              BrokerSubmitOrder order -> do
-              debugM "Strategy" "Order submitted"
+                debugM "Strategy" $ "Submitting order: " ++ show order
-              case maybeOid of
+                result <- submitOrder bs order
-                Right oid -> writeChan eventChan (OrderSubmitted order { orderId = oid })
+                debugM "Strategy" "Order submitted"
-                Left errmsg -> debugM "Strategy" $ T.unpack $ "Error: " `T.append` errmsg
+                case result of
-            BrokerCancelOrder oid -> do
+                  Right _ -> debugM "Strategy" $ "Order submitted: " ++ show (orderId order)
-              debugM "Strategy" $ "Cancelling order: " ++ show oid
-              _ <- cancelOrder bs oid
-              debugM "Strategy" "Order cancelled"
-            BrokerRequestNotifications -> do
-              t <- getCurrentTime
-              nt <- readIORef lastNotificationTime
-              when (t `diffUTCTime` nt > 1) $ do
-                maybeNs <- getNotifications bs
-                case maybeNs of
                   Left errmsg -> debugM "Strategy" $ T.unpack $ "Error: " `T.append` errmsg
-                  Right ns -> do
+              BrokerCancelOrder oid -> do
-                    mapM_ (sendNotification eventChan) ns
+                debugM "Strategy" $ "Cancelling order: " ++ show oid
-                    getCurrentTime >>= (writeIORef lastNotificationTime)
+                _ <- cancelOrder bs oid
-        nTimeout <- notTimeout lastNotificationTime
+                debugM "Strategy" "Order cancelled"
-        shouldShutdown <- isNothing <$> tryReadMVar shutdownVar
+              BrokerRequestNotifications -> do
-        debugM "Strategy" $ "Broker loop end: " ++ show nTimeout ++ "/" ++ show shouldShutdown)
+                t <- getCurrentTime
+                nt <- readIORef lastNotificationTime
+                when (t `diffUTCTime` nt > 1) $ do
+                  maybeNs <- getNotifications bs
+                  case maybeNs of
+                    Left errmsg -> debugM "Strategy" $ T.unpack $ "Error: " `T.append` errmsg
+                    Right ns -> do
+                      mapM_ (\n -> do
+                                prevSqnum <- atomicModifyIORef lastKnownSqnum (\s -> (getNotificationSqnum n, s))
+                                when (prevSqnum + 1 < getNotificationSqnum n) $
+                                  warningM "Strategy" $ "Sqnum jump: " ++ show prevSqnum ++ "->" ++ show (getNotificationSqnum n)
+                                sendNotification eventChan n) ns
+                      getCurrentTime >>= writeIORef lastNotificationTime
+              BrokerHandleNotification notification -> do
+                sendNotification eventChan n
+                prevSqnum <- atomicModifyIORef lastKnownSqnum (\s -> (getNotificationSqnum n, s))
+
+                undefined
+          nTimeout <- notTimeout lastNotificationTime
+          shouldShutdown <- isNothing <$> tryReadMVar shutdownVar
+          debugM "Strategy" $ "Broker loop end: " ++ show nTimeout ++ "/" ++ show shouldShutdown)
 
 notTimeout :: IORef UTCTime -> IO Bool
 notTimeout ts = do
@@ -78,5 +90,5 @@ notTimeout ts = do
 sendNotification :: BoundedChan Event -> Notification -> IO ()
 sendNotification eventChan notification =
   writeChan eventChan $ case notification of
-    OrderNotification oid state -> OrderUpdate oid state
+    OrderNotification sqnum oid state -> OrderUpdate oid state
-    TradeNotification trade     -> NewTrade trade
+    TradeNotification sqnum trade     -> NewTrade trade