diff --git a/src/TXMLConnector/Internal.hs b/src/TXMLConnector/Internal.hs index 3b61d43..c8597eb 100644 --- a/src/TXMLConnector/Internal.hs +++ b/src/TXMLConnector/Internal.hs @@ -35,19 +35,16 @@ import Control.Exception import Control.Monad (forM_, void, when) import Control.Monad.Extra (whileM) import qualified Data.Bimap as BM -import Data.Functor.Identity (Identity (..)) -import Data.Maybe (catMaybes, fromMaybe, mapMaybe) +import Data.Maybe (catMaybes, fromMaybe) import qualified Data.Text as T import Debug.EventCounters (emitEvent) -import Debug.Trace import qualified Deque.Strict as D import SlaveThread (fork) import System.IO import TickTable (TickTable, insertTick) import Transaq (AllTradesTrade, AllTradesTradeB (..), Candle, - CandleB (..), ClientData, - ClientDataB (..), + CandleB (..), ClientDataB (..), CommandCancelOrder (..), CommandChangePass (..), CommandConnect (..), @@ -57,14 +54,13 @@ import Transaq (AllTradesTrade, CommandSubscribe (..), ConnectionState (Disconnected), Language (LanguageEn), - MarketInfo, MarketInfoB (..), + MarketInfoB (..), OrderNotification, OrderNotificationB (..), OrderStatus (..), Quotation, QuotationB (..), ResponseAllTrades (ResponseAllTrades), ResponseCandleKinds (ResponseCandleKinds), - ResponseCandles, ResponseCandlesB (..), ResponseCandlesStatus (StatusPending), ResponseClient (ResponseClient), @@ -81,7 +77,6 @@ import Transaq (AllTradesTrade, TransaqCommand (toXml), TransaqResponse (..), TransaqResponse (..), - TransaqResponseC (fromXml), UnfilledAction (..), kCandleKindId, kPeriod, state) import Transaq.Parsing (parseTransaqResponsesFromText) @@ -105,7 +100,6 @@ import qualified ATrade.Types as AT import Control.Applicative ((<|>)) import Control.Concurrent.BoundedChan (BoundedChan, writeChan) import Control.Concurrent.STM.TMVar (TMVar) -import Control.Error (headMay) import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Reader.Class (MonadReader, asks) import Data.Int (Int64) @@ -398,7 +392,16 @@ handleConnected = do (takeTMVar timerVar' >> pure MainQueuePingServer) case item of MainQueueShutdown -> pure $ Just StageShutdown - MainQueuePingServer -> do + MainQueuePingServer -> pingServer + MainQueueTransaqData transaqData -> handleTransaqData transaqData + MainQueueRequest (RequestHistory request) -> processHistoryRequest request + MainQueueRequest (RequestSubmitOrder order) -> processSubmitOrderRequest order + MainQueueRequest (RequestCancelOrder oid) -> processCancelOrderRequest oid + + where + requestTimeoutValue = 10 + + pingServer = do maybeServerStatus <- sendCommand $ toXml CommandServerStatus case maybeServerStatus of Left serverStatusRaw -> case parseTransaqResponsesFromText serverStatusRaw of @@ -408,8 +411,8 @@ handleConnected = do log Warning "TXMLConnector.WorkThread" $ "Unable to parser server status response: " <> (T.pack . show ) serverStatusRaw pure Nothing Right () -> pure Nothing - MainQueueTransaqData transaqData -> handleTransaqData transaqData - MainQueueRequest (RequestHistory request) -> do + + processHistoryRequest request = do cur <- asks currentCandles liftIO $ atomically $ writeTVar cur [] maybeCk <- M.lookup (unBarTimeframe . hrTimeframe $ request) <$> (asks candleKindMap >>= liftIO . readTVarIO) @@ -426,7 +429,8 @@ handleConnected = do _ -> log Warning "TXMLConnector.WorkThread" $ "Unable to parse security ID: " <> hrTickerId request _ -> log Warning "TXMLConnector.WorkThread" $ "Invalid candlekind requested" <> (T.pack . show . unBarTimeframe . hrTimeframe $ request) pure Nothing - MainQueueRequest (RequestSubmitOrder order) -> do + + processSubmitOrderRequest order = do log Debug "TXMLConnector.WorkThread" $ "Incoming request: submit order " <> (T.pack . show) order case mkNewOrderCommand order of Just cmd -> do @@ -465,7 +469,8 @@ handleConnected = do log Warning "TXMLConnector.WorkThread" "Expected result, got nothing" pure Nothing _ -> pure Nothing - MainQueueRequest (RequestCancelOrder oid) -> do + + processCancelOrderRequest oid = do log Debug "TXMLConnector.WorkThread" $ "Incoming request: cancel order " <> (T.pack . show) oid brState <- asks brokerState respVar <- asks responseVar @@ -479,13 +484,10 @@ handleConnected = do liftIO . atomically $ putTMVar resp ResponseOrderCancelled pure Nothing - where - requestTimeoutValue = 10 - sendCancelOrder transactionId' = do respVar <- asks responseVar resp <- liftIO . atomically $ readTMVar respVar - v <- sendCommand . toXml $ (CommandCancelOrder $ toInteger transactionId') + v <- sendCommand . toXml $ CommandCancelOrder (toInteger transactionId') case v of Left result -> do log Debug "TXMLConnector.WorkThread" $ "Cancellation result: " <> (T.pack . show) result