|
|
|
@ -47,6 +47,7 @@ import TickTable (TickTable, insertTick, |
|
|
|
lookupTick, newTickTable) |
|
|
|
lookupTick, newTickTable) |
|
|
|
import Transaq (AllTradesTrade (..), |
|
|
|
import Transaq (AllTradesTrade (..), |
|
|
|
Candle (..), ClientData (..), |
|
|
|
Candle (..), ClientData (..), |
|
|
|
|
|
|
|
CommandCancelOrder (..), |
|
|
|
CommandChangePass (..), |
|
|
|
CommandChangePass (..), |
|
|
|
CommandConnect (..), |
|
|
|
CommandConnect (..), |
|
|
|
CommandDisconnect (CommandDisconnect), |
|
|
|
CommandDisconnect (CommandDisconnect), |
|
|
|
@ -427,6 +428,7 @@ handleConnected = do |
|
|
|
_ -> log Warning "TXMLConnector.WorkThread" $ "Invalid candlekind requested" <> (T.pack . show . unBarTimeframe . hrTimeframe $ request) |
|
|
|
_ -> log Warning "TXMLConnector.WorkThread" $ "Invalid candlekind requested" <> (T.pack . show . unBarTimeframe . hrTimeframe $ request) |
|
|
|
pure Nothing |
|
|
|
pure Nothing |
|
|
|
MainQueueRequest (RequestSubmitOrder order) -> do |
|
|
|
MainQueueRequest (RequestSubmitOrder order) -> do |
|
|
|
|
|
|
|
log Debug "TXMLConnector.WorkThread" $ "Incoming request: submit order " <> (T.pack . show) order |
|
|
|
case mkNewOrderCommand order of |
|
|
|
case mkNewOrderCommand order of |
|
|
|
Just cmd -> do |
|
|
|
Just cmd -> do |
|
|
|
v <- sendCommand . toXml $ cmd |
|
|
|
v <- sendCommand . toXml $ cmd |
|
|
|
@ -464,6 +466,31 @@ handleConnected = do |
|
|
|
log Warning "TXMLConnector.WorkThread" "Expected result, got nothing" |
|
|
|
log Warning "TXMLConnector.WorkThread" "Expected result, got nothing" |
|
|
|
pure Nothing |
|
|
|
pure Nothing |
|
|
|
_ -> pure Nothing |
|
|
|
_ -> pure Nothing |
|
|
|
|
|
|
|
MainQueueRequest (RequestCancelOrder oid) -> do |
|
|
|
|
|
|
|
log Debug "TXMLConnector.WorkThread" $ "Incoming request: cancel order " <> (T.pack . show) oid |
|
|
|
|
|
|
|
brState <- asks brokerState |
|
|
|
|
|
|
|
respVar <- asks responseVar |
|
|
|
|
|
|
|
resp <- liftIO . atomically $ readTMVar respVar |
|
|
|
|
|
|
|
transactionMap <- liftIO $ readTVarIO (bsOrderTransactionIdMap brState) |
|
|
|
|
|
|
|
case BM.lookup oid transactionMap of |
|
|
|
|
|
|
|
Just (TransactionId transactionId) -> do |
|
|
|
|
|
|
|
v <- sendCommand . toXml $ (CommandCancelOrder $ toInteger transactionId) |
|
|
|
|
|
|
|
case v of |
|
|
|
|
|
|
|
Left result -> do |
|
|
|
|
|
|
|
log Debug "TXMLConnector.WorkThread" $ "Cancellation result: " <> (T.pack . show) result |
|
|
|
|
|
|
|
liftIO . atomically $ putTMVar resp ResponseOrderCancelled |
|
|
|
|
|
|
|
_ -> liftIO . atomically $ putTMVar resp ResponseOrderCancelled |
|
|
|
|
|
|
|
Just (ExchangeOrderId eoid) -> do |
|
|
|
|
|
|
|
v <- sendCommand . toXml $ (CommandCancelOrder $ toInteger eoid) |
|
|
|
|
|
|
|
case v of |
|
|
|
|
|
|
|
Left result -> do |
|
|
|
|
|
|
|
log Debug "TXMLConnector.WorkThread" $ "Cancellation result: " <> (T.pack . show) result |
|
|
|
|
|
|
|
liftIO . atomically $ putTMVar resp ResponseOrderCancelled |
|
|
|
|
|
|
|
_ -> liftIO . atomically $ putTMVar resp ResponseOrderCancelled |
|
|
|
|
|
|
|
_ -> do |
|
|
|
|
|
|
|
log Debug "TXMLConnector.WorkThread" $ "Unable to locate transaction ID for order: " <> (T.pack . show) oid |
|
|
|
|
|
|
|
liftIO . atomically $ putTMVar resp ResponseOrderCancelled |
|
|
|
|
|
|
|
pure Nothing |
|
|
|
_ -> pure Nothing |
|
|
|
_ -> pure Nothing |
|
|
|
|
|
|
|
|
|
|
|
where |
|
|
|
where |
|
|
|
|
