brokerserver backend

src/Config.hs

@@ -24,6 +24,7 @@ data TransaqConnectorConfig = TransaqConnectorConfig {
   brokerClientCertificateDir  :: Maybe FilePath,
   tisEndpoint                 :: T.Text,
   historyProviderEndpoint     :: T.Text,
+  account                     :: T.Text,
   transaqLogin                :: T.Text,
   transaqPassword             :: T.Text,
   transaqHost                 :: T.Text,

src/HistoryProviderServer.hs

@@ -232,7 +232,7 @@ workThread = do
       let count = truncate diff `div` periodToSeconds (rqPeriod request)
       log Debug "HistoryProviderServer.WorkThread" $ "Requesting bars: " <> (T.pack . show) count
       txml <- asks eTxml
-      response <- liftIO . makeRequest txml $ Request HistoryRequest
+      response <- liftIO . makeRequest txml $ RequestHistory HistoryRequest
         {
           hrTickerId = rqTicker request
         , hrTimeframe = BarTimeframe . periodToSeconds . rqPeriod $ request

src/Main.hs

@@ -3,6 +3,9 @@ module Main (main) where
 
 import           ATrade                         (libatrade_gitrev,
                                                  libatrade_version)
+import           ATrade.Broker.Protocol         (NotificationSqnum (NotificationSqnum))
+import           ATrade.Broker.Server           (startBrokerServer,
+                                                 stopBrokerServer)
 import           ATrade.Logging                 (Message (..), Severity (Info),
                                                  logWith)
 import           ATrade.Logging                 (fmtMessage)
@@ -57,6 +60,15 @@ main = do
                  defaultServerSecurityParams)
         stopQuoteSourceServer $ \_ -> withTickerInfoServer logger ctx (tisEndpoint cfg) $ \tisH -> do
           txml <- Connector.start logger cfg qssChannel tisH
+          bracket (startBrokerServer
+                    [Connector.makeBrokerBackend txml (account cfg)]
+                    ctx
+                    (brokerEndpoint cfg)
+                    (brokerNotificationsEndpoint cfg)
+                    (NotificationSqnum 1)
+                    []
+                    defaultServerSecurityParams
+                    logger) stopBrokerServer $ \_ -> do
              withHistoryProviderServer ctx (historyProviderEndpoint cfg) txml logger id $ \_ -> do
                forever $ threadDelay 1000000
     log Info "main" "Shutting down"

src/TXMLConnector.hs

@@ -15,6 +15,7 @@ module TXMLConnector
   , HistoryResponse(..)
   , makeRequest
   , TXMLConnectorHandle
+  , makeBrokerBackend
   ) where
 
 import           ATrade.Logging                 (Message, Severity (..), log,
@@ -36,14 +37,16 @@ import           Control.Concurrent.STM         (TVar, atomically, modifyTVar',
 import           Control.Concurrent.STM.TBQueue (TBQueue, newTBQueue,
                                                  readTBQueue, writeTBQueue)
 import           Control.Monad                  (forever, void, when)
+import qualified Data.Bimap                     as BM
 import           Data.Maybe                     (mapMaybe)
 import qualified Data.Text                      as T
+import qualified Deque.Strict                   as D
 import           Text.XML.Light.Input           (parseXML)
 import           Text.XML.Light.Types           (Content (Elem),
                                                  Element (elName),
                                                  QName (qName))
 import           Transaq                        (AllTradesTrade (..),
-                                                 Candle (..),
+                                                 Candle (..), ClientData (..),
                                                  CommandConnect (..),
                                                  CommandDisconnect (CommandDisconnect),
                                                  CommandGetHistoryData (CommandGetHistoryData),
@@ -51,32 +54,45 @@ import           Transaq                        (AllTradesTrade (..),
                                                  ConnectionState (Disconnected),
                                                  Language (LanguageEn),
                                                  MarketInfo (..),
+                                                 OrderNotification (..),
+                                                 OrderStatus (..),
                                                  Quotation (..),
                                                  ResponseAllTrades (ResponseAllTrades),
                                                  ResponseCandleKinds (ResponseCandleKinds),
                                                  ResponseCandles (..),
                                                  ResponseCandlesStatus (StatusPending),
+                                                 ResponseClient (ResponseClient),
                                                  ResponseMarkets (ResponseMarkets),
+                                                 ResponseOrders (ResponseOrders),
                                                  ResponseQuotations (ResponseQuotations),
                                                  ResponseQuotes (ResponseQuotes),
+                                                 ResponseResult (..),
                                                  ResponseSecurities (ResponseSecurities),
+                                                 ResponseTrades (ResponseTrades),
                                                  Security (..), SecurityId (..),
+                                                 TradeNotification (..),
                                                  TransaqCommand (toXml),
                                                  TransaqResponse (..),
                                                  TransaqResponse (..),
                                                  TransaqResponseC (fromXml),
-                                                 kCandleKindId, kPeriod, state,
-                                                 status)
+                                                 UnfilledAction (..),
+                                                 kCandleKindId, kPeriod, state)
 import           TXML                           (LogLevel, freeCallback,
                                                  initialize, sendCommand,
                                                  setCallback)
 
+import           ATrade.Broker.Backend          (BrokerBackend (..),
+                                                 BrokerBackendNotification (..))
 import           ATrade.QuoteSource.Server      (QuoteSourceServerData (..))
 import           ATrade.Types                   (Bar (..),
                                                  BarTimeframe (unBarTimeframe),
                                                  DataType (BestBid, BestOffer, LastTradePrice),
-                                                 Tick (..), TickerId,
-                                                 fromDouble)
+                                                 Order (..), OrderId,
+                                                 OrderPrice (..),
+                                                 OrderState (..), Tick (..),
+                                                 TickerId, Trade (..),
+                                                 fromDouble, toDouble)
+import qualified ATrade.Types                   as AT
 import           Colog.Monad                    (WithLog)
 import           Control.Concurrent.BoundedChan (BoundedChan, writeChan)
 import           Control.Concurrent.STM.TMVar   (TMVar)
@@ -84,9 +100,11 @@ import           Control.Monad                  (forM_)
 import           Control.Monad.IO.Class         (MonadIO (liftIO))
 import           Control.Monad.Reader           (ReaderT (runReaderT))
 import           Control.Monad.Reader.Class     (MonadReader, asks)
+import           Data.Int                       (Int64)
 import qualified Data.Map.Strict                as M
 import           Data.Time.Clock                (UTCTime, diffUTCTime,
                                                  getCurrentTime)
+import           GHC.Exts                       (IsList (..))
 import           Prelude                        hiding (log)
 import           TickerInfoServer               (TickerInfo (..),
                                                  TickerInfoServerHandle,
@@ -115,12 +133,16 @@ data HistoryRequest =
   , hrReset     :: Bool
   } deriving (Show, Eq, Ord)
 
-newtype Request =
-  Request HistoryRequest
-  deriving (Show, Eq, Ord)
+data Request =
+  RequestHistory HistoryRequest
+  | RequestSubmitOrder Order
+  | RequestCancelOrder OrderId
+  deriving (Show, Eq)
 
 data Response =
     ResponseHistory HistoryResponse
+  | ResponseOrderSubmitted
+  | ResponseOrderCancelled
   | ResponseTimeout
 
 data HistoryResponse =
@@ -139,6 +161,7 @@ data TXMLConnectorHandle =
   , hRequestVar           :: TMVar Request
   , hResponseVar          :: TMVar (TMVar Response)
   , hRequestTimestamp     :: TVar UTCTime
+  , hNotificationCallback :: TVar (Maybe (BrokerBackendNotification -> IO ()))
   }
 
 data ConnectionStage = StageConnection | StageGetInfo | StageConnected
@@ -147,11 +170,25 @@ data ConnectionStage = StageConnection | StageGetInfo | StageConnected
 data MainQueueData =
     MainQueueTransaqData TransaqResponse
   | MainQueueRequest Request
-  deriving (Eq, Show, Ord)
+  deriving (Eq, Show)
 
 data TickKey = TickKey TickerId DataType
   deriving (Show, Ord, Eq)
 
+data TransactionId =
+    TransactionId Int64
+  | ExchangeOrderId Int64
+  deriving (Show, Ord, Eq)
+
+data BrokerState =
+  BrokerState
+  {
+    bsOrderTransactionIdMap :: TVar (BM.Bimap OrderId TransactionId)
+  , bsNotificationCallback  :: TVar (Maybe (BrokerBackendNotification -> IO ()))
+  , bsOrderMap              :: TVar (M.Map OrderId Order)
+  , bsPendingOrders         :: TVar (D.Deque Order)
+  }
+
 data Env =
   Env
   {
@@ -167,6 +204,7 @@ data Env =
   , config           :: TransaqConnectorConfig
   , serverConnected  :: TVar ConnectionStage
   , candleKindMap    :: TVar (M.Map Int Int)
+  , brokerState      :: BrokerState
   }
 
 newtype App a = App { unApp :: ReaderT Env IO a }
@@ -192,6 +230,18 @@ start logger config qssChannel tisH = do
   serverConnected <- liftIO $ newTVarIO StageConnection
   candleKindMap <- newTVarIO M.empty
   requestTimestamp <- getCurrentTime >>= newTVarIO
+  orderMap <- newTVarIO M.empty
+  notificationCallback <- newTVarIO Nothing
+  orderTransactionIdMap <- newTVarIO BM.empty
+  pendingOrders <- newTVarIO (fromList [])
+  let brokerState =
+        BrokerState
+        {
+          bsOrderTransactionIdMap = orderTransactionIdMap
+        , bsNotificationCallback = notificationCallback
+        , bsOrderMap = orderMap
+        , bsPendingOrders = pendingOrders
+        }
   let env =
         Env
         {
@@ -207,6 +257,7 @@ start logger config qssChannel tisH = do
         , config = config
         , serverConnected = serverConnected
         , candleKindMap = candleKindMap
+        , brokerState = brokerState
         }
   threadId <- forkIO $ (runReaderT . unApp) workThread env
   return $ TXMLConnectorHandle
@@ -215,6 +266,8 @@ start logger config qssChannel tisH = do
     , notificationQueue = notificationQueue
     , hRequestVar = requestVar
     , hResponseVar = responseVar
+    , hRequestTimestamp = requestTimestamp
+    , hNotificationCallback = notificationCallback
     }
 
 workThread :: App ()
@@ -299,8 +352,19 @@ workThread = do
                         , hrMoreData = False
                         }
                 _ -> log Warning "TXMLConnector.WorkThread" "Incoming candles without response var"
+            TransaqResponseOrders (ResponseOrders orders) -> forM_ orders handleOrder
+            TransaqResponseTrades (ResponseTrades trades) -> forM_ trades handleTrade
+            TransaqResponseResult (ResponseSuccess (Just transactionId)) -> do
+              brState <- asks brokerState
+              liftIO $ atomically $ do
+                deque <- readTVar (bsPendingOrders brState)
+                case D.uncons deque of
+                  Just (order, deque') -> do
+                    writeTVar (bsPendingOrders brState) deque'
+                    modifyTVar' (bsOrderTransactionIdMap brState) (BM.insert (orderId order) (TransactionId transactionId))
+                  Nothing -> pure ()
             _ -> pure ()
-        MainQueueRequest (Request request) -> do
+        MainQueueRequest (RequestHistory request) -> do
           cur <- asks currentCandles
           liftIO $ atomically $ writeTVar cur []
           maybeCk <- M.lookup (unBarTimeframe . hrTimeframe $ request) <$> (asks candleKindMap >>= liftIO . readTVarIO)
@@ -317,10 +381,83 @@ workThread = 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)
+        MainQueueRequest (RequestSubmitOrder order) -> do
+          case mkNewOrderCommand order of
+            Just cmd -> do
+              v <- liftIO . sendCommand . toXml $ cmd
+              case v of
+                Left err -> log Warning "TXMLConnector.WorkThread" $ "Unable to send request: [" <> err <> "]"
+                Right _ -> do
+                  brState <- asks brokerState
+                  liftIO $ atomically $ do
+                    modifyTVar' (bsPendingOrders brState) (order `D.snoc`)
+                    modifyTVar' (bsOrderMap brState) (M.insert (orderId order) order)
+            _ -> pure ()
+        _ -> pure ()
+
       checkRequestTimeout
 
     requestTimeout = 10
 
+    handleTrade transaqTrade = do
+      brState <- asks brokerState
+      trIdMap <- liftIO $ readTVarIO (bsOrderTransactionIdMap brState)
+      maybeCb <- liftIO $ readTVarIO (bsNotificationCallback brState)
+      orderMap <- liftIO $ readTVarIO (bsOrderMap brState)
+      case maybeCb of
+        Just cb -> case BM.lookupR (ExchangeOrderId (tOrderNo transaqTrade)) trIdMap of
+          Just oid -> case M.lookup oid orderMap of
+            Just order -> liftIO $ cb (BackendTradeNotification (fromTransaqTrade transaqTrade order))
+            _ -> pure ()
+          _ -> pure ()
+        Nothing -> pure ()
+
+    fromTransaqTrade transaqTrade order =
+      Trade
+      {
+        tradeOrderId = orderId order
+      , tradePrice = fromDouble (tPrice transaqTrade)
+      , tradeQuantity = fromIntegral $ tQuantity transaqTrade
+      , tradeVolume = fromDouble $ tValue transaqTrade
+      , tradeVolumeCurrency = ""
+      , tradeOperation = fromDirection (tBuysell transaqTrade)
+      , tradeAccount = tClient transaqTrade <> "#" <> tUnion transaqTrade
+      , tradeSecurity = tBoard transaqTrade <> "#" <> tSecCode transaqTrade
+      , tradeTimestamp = tTimestamp transaqTrade
+      , tradeCommission = fromDouble $ tComission transaqTrade
+      , tradeSignalId = orderSignalId order
+      }
+
+    fromDirection Transaq.Buy  = AT.Buy
+    fromDirection Transaq.Sell = AT.Sell
+
+    handleOrder orderUpdate = do
+      brState <- asks brokerState
+      trIdMap <- liftIO $ readTVarIO (bsOrderTransactionIdMap brState)
+      maybeCb <- liftIO $ readTVarIO (bsNotificationCallback brState)
+      case maybeCb of
+        Just cb -> case BM.lookupR (TransactionId (fromIntegral $ oTransactionId orderUpdate)) trIdMap of
+          Just oid -> liftIO $ cb (BackendOrderNotification oid (orderStateFromTransaq orderUpdate))
+          _ -> pure ()
+        Nothing -> pure ()
+
+    orderStateFromTransaq orderUpdate =
+      case oStatus orderUpdate of
+        OrderActive     -> Submitted
+        OrderCancelled  -> Cancelled
+        OrderDenied     -> Rejected
+        OrderDisabled   -> Rejected
+        OrderExpired    -> Cancelled
+        OrderFailed     -> Rejected
+        OrderForwarding -> Unsubmitted
+        OrderInactive   -> OrderError
+        OrderMatched    -> Executed
+        OrderRefused    -> Rejected
+        OrderRemoved    -> Rejected
+        OrderWait       -> Unsubmitted
+        OrderWatching   -> Unsubmitted
+        _               -> OrderError
+
     checkRequestTimeout = do
       now <- liftIO getCurrentTime
       tsVar <- asks requestTimestamp
@@ -381,6 +518,9 @@ workThread = do
         TransaqResponseSecInfo secInfo ->
           log Debug "TXMLConnector.WorkThread" $ "Incoming secinfo:" <> (T.pack . show) secInfo
           -- TODO: Pass to qtis
+        TransaqResponseClient (ResponseClient clientData) -> do
+          log Debug "TXMLConnector.WorkThread" $
+            "Incoming client data: " <> (T.pack . show) (cClientId clientData) <> "#" <> (T.pack . show) (cUnion clientData)
         _ -> pure ()
     handleUnconnected :: App ()
     handleUnconnected = do
@@ -494,6 +634,12 @@ parseSecurityId tickerId = case T.findIndex (== '#') tickerId of
 makeTickerId :: SecurityId -> TickerId
 makeTickerId sec = board sec <> "#" <> seccode sec
 
+parseAccountId :: T.Text -> Maybe (T.Text, T.Text)
+parseAccountId accId = case T.findIndex (== '#') accId of
+  Just ix -> Just (T.take ix accId, T.drop (ix + 1) accId)
+  Nothing -> Nothing
+
+
 makeRequest :: TXMLConnectorHandle -> Request -> IO Response
 makeRequest h request = do
   now <- getCurrentTime
@@ -507,6 +653,46 @@ makeRequest h request = do
     void $ takeTMVar (hResponseVar h)
     takeTMVar resp
 
+mkNewOrderCommand :: Order -> Maybe Transaq.CommandNewOrder
+mkNewOrderCommand order =
+  case parseSecurityId (orderSecurity order) of
+    Just secId ->
+      case parseAccountId (orderAccountId order) of
+        Just (client, union) -> do
+          case orderPrice order of
+            Market -> Just $ Transaq.CommandNewOrder
+                              {
+                                security = secId
+                              , client = client
+                              , unionCode = union
+                              , price = 0
+                              , quantity = fromInteger $ orderQuantity order
+                              , buysell = toDirection $ orderOperation order
+                              , bymarket = True
+                              , brokerRef = T.empty
+                              , unfilled = UnfilledPutInQueue
+                              , usecredit = False
+                              , nosplit = False
+                              }
+            Limit price -> Just $ Transaq.CommandNewOrder
+                              {
+                                security = secId
+                              , client = client
+                              , unionCode = union
+                              , price = toDouble price
+                              , quantity = fromInteger $ orderQuantity order
+                              , buysell = toDirection $ orderOperation order
+                              , bymarket = False
+                              , brokerRef = T.empty
+                              , unfilled = UnfilledPutInQueue
+                              , usecredit = False
+                              , nosplit = False
+                              }
+            _ -> Nothing
+  where
+    toDirection AT.Buy  = Transaq.Buy
+    toDirection AT.Sell = Transaq.Sell
+
 
 candleToBar :: SecurityId -> Candle -> Bar
 candleToBar sec candle =
@@ -520,3 +706,17 @@ candleToBar sec candle =
   , barClose = fromDouble (cClose candle)
   , barVolume = fromIntegral $ cVolume candle
   }
+
+brSubmitOrder :: TXMLConnectorHandle -> Order -> IO ()
+brSubmitOrder h order = void $ makeRequest h (RequestSubmitOrder order)
+
+brCancelOrder :: TXMLConnectorHandle -> OrderId -> IO ()
+brCancelOrder h oid = void $ makeRequest h (RequestCancelOrder oid)
+
+brSetNotificationCallback :: TXMLConnectorHandle -> Maybe (BrokerBackendNotification -> IO ()) -> IO ()
+brSetNotificationCallback h cb = atomically $ writeTVar (hNotificationCallback h) cb
+
+makeBrokerBackend :: TXMLConnectorHandle -> T.Text -> BrokerBackend
+makeBrokerBackend h account =
+  BrokerBackend [account] (brSetNotificationCallback h) (brSubmitOrder h) (brCancelOrder h) (pure ())
+

src/Transaq.hs

@@ -26,10 +26,14 @@ module Transaq
     ResponseAllTrades(..),
     ResponseTrades(..),
     ResponseQuotes(..),
+    ResponseOrders(..),
+    ResponseClient(..),
+    ClientData(..),
     Quotation(..),
     Quote(..),
     TradeNotification(..),
     OrderNotification(..),
+    OrderStatus(..),
     AllTradesTrade(..),
     Tick(..),
     ConnectionState(..),
@@ -37,7 +41,9 @@ module Transaq
     Security(..),
     CandleKind(..),
     ResponseCandlesStatus(..),
-    Candle(..)
+    Candle(..),
+    UnfilledAction(..),
+    TradeDirection(..)
   ) where
 
 import           Control.Applicative   ((<|>))
@@ -253,7 +259,7 @@ data CommandNewOrder =
     security  :: SecurityId
   , client    :: T.Text
   , unionCode :: T.Text
-  , price     :: TransaqPrice
+  , price     :: Double
   , quantity  :: Int
   , buysell   :: TradeDirection
   , bymarket  :: Bool
@@ -305,7 +311,7 @@ instance TransaqCommand CommandGetSecuritiesInfo where
       fmap (unode "security") securities)
 
 data ResponseResult =
-    ResponseSuccess
+    ResponseSuccess (Maybe Int64)
   | ResponseFailure T.Text
   deriving (Show, Eq, Ord)
 
@@ -314,7 +320,7 @@ instance TransaqResponseC ResponseResult where
     if qName (elName root) == "result"
       then
         if findAttr (blank_name {qName = "success"}) root == Just "true"
-          then Just ResponseSuccess
+          then Just $ ResponseSuccess (findAttr (uname "transactionid") root >>= readMaybe)
           else Just . ResponseFailure . T.pack . concatMap cdData . onlyText . elContent $ root
       else Nothing
 
@@ -452,6 +458,33 @@ instance TransaqResponseC ResponseMarkets where
           pure $ Just $ MarketInfo {..}
         else pure Nothing
 
+data ClientData =
+  ClientData
+  {
+    cClientId :: T.Text
+  , cType     :: T.Text
+  , cCurrency :: T.Text
+  , cMarket   :: T.Text
+  , cUnion    :: T.Text
+  , cForts    :: Maybe T.Text
+  } deriving (Show, Eq, Ord)
+
+newtype ResponseClient = ResponseClient ClientData
+  deriving (Show, Eq, Ord)
+
+instance TransaqResponseC ResponseClient where
+  fromXml root = do
+    if (qName . elName) root == "client"
+    then do
+      cClientId <- T.pack <$> findAttr (uname "id") root
+      cType <- T.pack <$> childContent "type" root
+      cCurrency <- T.pack <$> childContent "currency" root
+      cMarket <- T.pack <$> childContent "market" root
+      cUnion <- T.pack <$> childContent "union" root
+      let cForts = T.pack <$> childContent "forts_acc" root
+      Just $ ResponseClient $ ClientData {..}
+    else Nothing
+
 data CandleKind =
   CandleKind
   {
@@ -515,7 +548,7 @@ instance TransaqResponseC ResponseSecurities where
           sInstrClass <- T.pack <$> childContent "instrclass" tag
           sBoard <- T.pack <$> childContent "board" tag
           sMarket <- T.pack <$> childContent "market" tag
-          sCurrency <- T.pack <$> childContent "currency" tag
+          let sCurrency = fromMaybe "" $ T.pack <$> childContent "currency" tag
           sShortName <- T.pack <$> childContent "shortname" tag
           sDecimals <- childContent "decimals" tag >>= readMaybe
           sMinStep <- childContent "minstep" tag >>= readMaybe
@@ -709,42 +742,40 @@ instance TransaqResponseC ResponseQuotes where
         return . Just $ Quote {..}
 
 data OrderStatus =
-    OrderCancelled
+    OrderActive
+  | OrderCancelled
   | OrderDenied
   | OrderDisabled
   | OrderExpired
   | OrderFailed
-  | OrderLinkWait
+  | OrderForwarding
+  | OrderInactive
+  | OrderMatched
+  | OrderRefused
   | OrderRejected
-  | OrderSLExecuted
-  | OrderSLForwarding
-  | OrderSLGuardTime
-  | OrderTPCorrection
-  | OrderTPCorrectionGuardTime
-  | OrderTPExecuted
-  | OrderTPForwarding
-  | OrderTPGuardTime
+  | OrderRemoved
+  | OrderWait
   | OrderWatching
   deriving (Show, Eq, Ord)
 
 data OrderNotification =
   OrderNotification
   {
-    transactionId :: Int
-  , orderNo       :: Int64
-  , secId         :: Int
-  , board         :: T.Text
-  , secCode       :: T.Text
-  , client        :: T.Text
-  , union         :: T.Text
-  , status        :: OrderStatus
-  , buysell       :: TradeDirection
-  , timestamp     :: UTCTime
-  , brokerRef     :: T.Text
-  , balance       :: Int
-  , price         :: Double
-  , quantity      :: Int
-  , result        :: T.Text
+    oTransactionId :: Int
+  , oOrderNo       :: Int64
+  , oSecId         :: Int
+  , oBoard         :: T.Text
+  , oSecCode       :: T.Text
+  , oClient        :: T.Text
+  , oUnion         :: T.Text
+  , oStatus        :: OrderStatus
+  , oBuysell       :: TradeDirection
+  , oTimestamp     :: UTCTime
+  , oBrokerRef     :: T.Text
+  , oBalance       :: Int
+  , oPrice         :: Double
+  , oQuantity      :: Int
+  , oResult        :: T.Text
   } deriving (Show, Eq, Ord)
 
 newtype ResponseOrders =
@@ -757,55 +788,54 @@ instance TransaqResponseC ResponseOrders where
     pure . ResponseOrders . catMaybes $ quotes
     where
       parseOrder tag = do
-        transactionId <- findAttr (uname "transactionid") tag >>= readMaybe
-        orderNo <- childContent "orderno" tag >>= readMaybe
-        secId <- childContent "secid" tag >>= readMaybe
-        board <- T.pack <$> childContent "board" tag
-        secCode <- T.pack <$> childContent "seccode" tag
-        client <- T.pack <$> childContent "client" tag
-        union <- T.pack <$> childContent "union" tag
-        status <- childContent "status" tag >>= parseStatus
-        buysell <- childContent "buysell" tag >>= parseTradeDirection . T.pack
-        timestamp <- childContent "time" tag >>= parseTimestamp . T.pack
-        brokerRef <- T.pack <$> childContent "brokerref" tag
-        balance <- childContent "balance" tag >>= readMaybe
-        price <- childContent "price" tag >>= readMaybe
-        quantity <- childContent "quantity" tag >>= readMaybe
-        result <- T.pack <$> childContent "result" tag
+        oTransactionId <- findAttr (uname "transactionid") tag >>= readMaybe
+        oOrderNo <- childContent "orderno" tag >>= readMaybe
+        oSecId <- childContent "secid" tag >>= readMaybe
+        oBoard <- T.pack <$> childContent "board" tag
+        oSecCode <- T.pack <$> childContent "seccode" tag
+        oClient <- T.pack <$> childContent "client" tag
+        oUnion <- T.pack <$> childContent "union" tag
+        oStatus <- childContent "status" tag >>= parseStatus
+        oBuysell <- childContent "buysell" tag >>= parseTradeDirection . T.pack
+        oTimestamp <- childContent "time" tag >>= parseTimestamp . T.pack
+        oBrokerRef <- T.pack <$> childContent "brokerref" tag
+        oBalance <- childContent "balance" tag >>= readMaybe
+        oPrice <- childContent "price" tag >>= readMaybe
+        oQuantity <- childContent "quantity" tag >>= readMaybe
+        oResult <- T.pack <$> childContent "result" tag
         return . Just $ OrderNotification {..}
+      parseStatus "active"     = Just OrderActive
       parseStatus "cancelled"  = Just OrderCancelled
       parseStatus "denied"     = Just OrderDenied
       parseStatus "disabled"   = Just OrderDisabled
       parseStatus "expired"    = Just OrderExpired
       parseStatus "failed"     = Just OrderFailed
-      parseStatus "linkwait"                = Just OrderLinkWait
+      parseStatus "forwarding" = Just OrderForwarding
+      parseStatus "inactive"   = Just OrderInactive
+      parseStatus "matched"    = Just OrderMatched
+      parseStatus "refused"    = Just OrderRefused
       parseStatus "rejected"   = Just OrderRejected
-      parseStatus "sl_executed"             = Just OrderSLExecuted
-      parseStatus "sl_forwarding"           = Just OrderSLForwarding
-      parseStatus "sl_guardtime"            = Just OrderSLGuardTime
-      parseStatus "tp_correction"           = Just OrderTPCorrection
-      parseStatus "tp_correction_guardtime" = Just OrderTPCorrectionGuardTime
-      parseStatus "tp_executed"             = Just OrderTPExecuted
-      parseStatus "tp_forwarding"           = Just OrderTPForwarding
-      parseStatus "tp_guardtime"            = Just OrderTPGuardTime
+      parseStatus "removed"    = Just OrderRemoved
+      parseStatus "wait"       = Just OrderWait
       parseStatus "watching"   = Just OrderWatching
       parseStatus _            = Nothing
 
 data TradeNotification =
   TradeNotification
   {
-    secId     :: Int
-  , tradeNo   :: Int64
-  , orderNo   :: Int64
-  , board     :: T.Text
-  , secCode   :: T.Text
-  , client    :: T.Text
-  , union     :: T.Text
-  , buysell   :: TradeDirection
-  , timestamp :: UTCTime
-  , value     :: Double
-  , comission :: Double
-  , price     :: Double
+    tSecId     :: Int
+  , tTradeNo   :: Int64
+  , tOrderNo   :: Int64
+  , tBoard     :: T.Text
+  , tSecCode   :: T.Text
+  , tClient    :: T.Text
+  , tUnion     :: T.Text
+  , tBuysell   :: TradeDirection
+  , tTimestamp :: UTCTime
+  , tValue     :: Double
+  , tComission :: Double
+  , tQuantity  :: Int
+  , tPrice     :: Double
   } deriving (Show, Eq, Ord)
 
 newtype ResponseTrades =
@@ -818,18 +848,19 @@ instance TransaqResponseC ResponseTrades where
     pure . ResponseTrades . catMaybes $ quotes
     where
       parseTrade tag = do
-        secId <- childContent "secid" tag >>= readMaybe
-        tradeNo <- childContent "tradeno" tag >>= readMaybe
-        orderNo <- childContent "orderno" tag >>= readMaybe
-        board <- T.pack <$> childContent "board" tag
-        secCode <- T.pack <$> childContent "seccode" tag
-        client <- T.pack <$> childContent "client" tag
-        union <- T.pack <$> childContent "union" tag
-        buysell <- childContent "buysell" tag >>= parseTradeDirection . T.pack
-        timestamp <- childContent "time" tag >>= parseTimestamp . T.pack
-        value <- childContent "value" tag >>= readMaybe
-        comission <- childContent "comission" tag >>= readMaybe
-        price <- childContent "price" tag >>= readMaybe
+        tSecId <- childContent "secid" tag >>= readMaybe
+        tTradeNo <- childContent "tradeno" tag >>= readMaybe
+        tOrderNo <- childContent "orderno" tag >>= readMaybe
+        tBoard <- T.pack <$> childContent "board" tag
+        tSecCode <- T.pack <$> childContent "seccode" tag
+        tClient <- T.pack <$> childContent "client" tag
+        tUnion <- T.pack <$> childContent "union" tag
+        tBuysell <- childContent "buysell" tag >>= parseTradeDirection . T.pack
+        tTimestamp <- childContent "time" tag >>= parseTimestamp . T.pack
+        tValue <- childContent "value" tag >>= readMaybe
+        tComission <- childContent "comission" tag >>= readMaybe
+        tQuantity <- childContent "quantity" tag >>= readMaybe
+        tPrice <- childContent "price" tag >>= readMaybe
         pure . Just $ TradeNotification {..}
 
 data Tick =
@@ -854,6 +885,7 @@ newtype ResponseTicks =
 data TransaqResponse =
     TransaqResponseResult ResponseResult
   | TransaqResponseCandles ResponseCandles
+  | TransaqResponseClient ResponseClient
   | TransaqResponseServerStatus ResponseServerStatus
   | TransaqResponseMarkets ResponseMarkets
   | TransaqResponseCandleKinds ResponseCandleKinds
@@ -870,6 +902,7 @@ instance TransaqResponseC TransaqResponse where
   fromXml root = case qName . elName $ root of
     "result"        -> TransaqResponseResult <$> fromXml root
     "error"         -> TransaqResponseResult <$> fromXml root
+    "client"        -> TransaqResponseClient <$> fromXml root
     "candles"       -> TransaqResponseCandles <$> fromXml root
     "server_status" -> TransaqResponseServerStatus <$> fromXml root
     "markets"       -> TransaqResponseMarkets <$> fromXml root

transaq-connector.cabal

@@ -50,6 +50,8 @@ executable transaq-connector
                      , mtl
                      , vector
                      , binary
+                     , bimap
+                     , deque
   extra-lib-dirs:      lib
   ghc-options:         -Wall
                        -Wcompat