From 70bd908d9b07b019e3c182274572f49cc32e9c3b Mon Sep 17 00:00:00 2001
From: Denis Tereshkin <denis@kasan.ws>
Date: Sun, 27 Aug 2023 12:01:18 +0700
Subject: [PATCH] txmlconnector: support order cancellation

---
 src/TXMLConnector/Internal.hs | 27 +++++++++++++++++++++++++++
 1 file changed, 27 insertions(+)

diff --git a/src/TXMLConnector/Internal.hs b/src/TXMLConnector/Internal.hs
index 5e2ba65..ac588b3 100644
--- a/src/TXMLConnector/Internal.hs
+++ b/src/TXMLConnector/Internal.hs
@@ -47,6 +47,7 @@ import           TickTable                      (TickTable, insertTick,
                                                  lookupTick, newTickTable)
 import           Transaq                        (AllTradesTrade (..),
                                                  Candle (..), ClientData (..),
+                                                 CommandCancelOrder (..),
                                                  CommandChangePass (..),
                                                  CommandConnect (..),
                                                  CommandDisconnect (CommandDisconnect),
@@ -427,6 +428,7 @@ handleConnected = do
         _ -> log Warning "TXMLConnector.WorkThread" $ "Invalid candlekind requested" <> (T.pack . show . unBarTimeframe . hrTimeframe $ request)
       pure Nothing
     MainQueueRequest (RequestSubmitOrder order) -> do
+      log Debug "TXMLConnector.WorkThread" $ "Incoming request: submit order " <> (T.pack . show) order
       case mkNewOrderCommand order of
         Just cmd -> do
           v <- sendCommand . toXml $ cmd
@@ -464,6 +466,31 @@ handleConnected = do
               log Warning "TXMLConnector.WorkThread" "Expected result, got 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
 
   where