txmlconnector: support order cancellation

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