Handle transaction callback error code

src/Broker/QuikBroker/Trans2QuikApi.hs

@@ -1,5 +1,5 @@
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE OverloadedStrings  #-}
 
 module Broker.QuikBroker.Trans2QuikApi (
   Trans2QuikApi(..),
@@ -12,30 +12,30 @@ module Broker.QuikBroker.Trans2QuikApi (
   quikSendTransaction
 ) where
 
-import Foreign
+import           Codec.Text.IConv
-import Foreign.C.Types
+import           Control.Concurrent
-import Foreign.C.String
+import           Control.Error.Util
-import Foreign.Marshal.Array
+import           Control.Exception.Safe
-import Control.Monad
+import           Control.Monad
-import Control.Monad.Trans.Except
+import           Control.Monad.IO.Class
-import Control.Error.Util
+import           Control.Monad.Trans.Except
-import Control.Monad.IO.Class
+import qualified Data.ByteString            as BS
-import System.Win32.DLL
+import qualified Data.ByteString.Lazy       as BL
-import System.Win32.Types
+import           Data.IORef
-import Control.Concurrent
+import           Data.Ratio
-import Control.Exception.Safe
+import qualified Data.Set                   as S
-import Data.IORef
+import qualified Data.Text                  as T
-import Data.Time.Clock
+import           Data.Text.Encoding
-import Data.Time.Calendar
+import           Data.Time.Calendar
-import Data.Ratio
+import           Data.Time.Clock
-import Data.Typeable
+import           Data.Typeable
-import qualified Data.ByteString as BS
+import           Foreign
-import qualified Data.ByteString.Lazy as BL
+import           Foreign.C.String
-import qualified Data.Set as S
+import           Foreign.C.Types
-import qualified Data.Text as T
+import           Foreign.Marshal.Array
-import Data.Text.Encoding
+import           System.Log.Logger
-import System.Log.Logger
+import           System.Win32.DLL
-import Codec.Text.IConv
+import           System.Win32.Types
 
 type QuikErrorCode = LONG
 
@@ -293,113 +293,113 @@ foreign import stdcall "dynamic"
   mkTradeKindFun :: FunPtr TradeKindF -> TradeKindF
 
 toDouble :: CDouble -> Double
-toDouble (CDouble x) = x 
+toDouble (CDouble x) = x
 
 data Trans2QuikApi = Trans2QuikApi {
-  connect :: ConnectF,
+  connect                      :: ConnectF,
-  disconnect :: DisconnectF,
+  disconnect                   :: DisconnectF,
-  isQuikConnected :: IsQuikConnectedF,
+  isQuikConnected              :: IsQuikConnectedF,
-  isDllConnected :: IsDllConnectedF,
+  isDllConnected               :: IsDllConnectedF,
-  sendSyncTransaction :: SendSyncTransactionF,
+  sendSyncTransaction          :: SendSyncTransactionF,
-  sendAsyncTransaction :: SendAsyncTransactionF,
+  sendAsyncTransaction         :: SendAsyncTransactionF,
-  setConnectionStatusCallback :: SetConnectionStatusCallbackF,
+  setConnectionStatusCallback  :: SetConnectionStatusCallbackF,
   setTransactionsReplyCallback :: SetTransactionsReplyCallbackF,
-  subscribeOrders :: SubscribeOrdersF,
+  subscribeOrders              :: SubscribeOrdersF,
-  subscribeTrades :: SubscribeTradesF,
+  subscribeTrades              :: SubscribeTradesF,
-  startOrders :: StartOrdersF,
+  startOrders                  :: StartOrdersF,
-  startTrades :: StartTradesF,
+  startTrades                  :: StartTradesF,
-  unsubscribeOrders :: UnsubscribeOrdersF,
+  unsubscribeOrders            :: UnsubscribeOrdersF,
-  unsubscribeTrades :: UnsubscribeTradesF,
+  unsubscribeTrades            :: UnsubscribeTradesF,
-
+
-  orderQty :: OrderQtyF,
+  orderQty                     :: OrderQtyF,
-  orderDate :: OrderDateF,
+  orderDate                    :: OrderDateF,
-  orderTime :: OrderTimeF,
+  orderTime                    :: OrderTimeF,
-  orderActivationTime :: OrderActivationTimeF,
+  orderActivationTime          :: OrderActivationTimeF,
-  orderWithdrawTime :: OrderWithdrawTimeF,
+  orderWithdrawTime            :: OrderWithdrawTimeF,
-  orderExpiry :: OrderExpiryF,
+  orderExpiry                  :: OrderExpiryF,
-  orderAccruedInt :: OrderAccruedIntF,
+  orderAccruedInt              :: OrderAccruedIntF,
-  orderYield :: OrderYieldF,
+  orderYield                   :: OrderYieldF,
-  orderUserId :: OrderUserIdF,
+  orderUserId                  :: OrderUserIdF,
-  orderUid :: OrderUidF,
+  orderUid                     :: OrderUidF,
-  orderAccount :: OrderAccountF,
+  orderAccount                 :: OrderAccountF,
-  orderBrokerRef :: OrderBrokerRefF,
+  orderBrokerRef               :: OrderBrokerRefF,
-  orderClientCode :: OrderClientCodeF,
+  orderClientCode              :: OrderClientCodeF,
-  orderFirmId :: OrderFirmIdF,
+  orderFirmId                  :: OrderFirmIdF,
-  orderVisibleQty :: OrderVisibleQtyF,
+  orderVisibleQty              :: OrderVisibleQtyF,
-  orderPeriod :: OrderPeriodF,
+  orderPeriod                  :: OrderPeriodF,
-  orderDateTime :: OrderDateTimeF,
+  orderDateTime                :: OrderDateTimeF,
-
+
-  tradeDate :: TradeDateF,
+  tradeDate                    :: TradeDateF,
-  tradeSettleDate :: TradeSettleDateF,
+  tradeSettleDate              :: TradeSettleDateF,
-  tradeTime :: TradeTimeF,
+  tradeTime                    :: TradeTimeF,
-  tradeIsMarginal :: TradeIsMarginalF,
+  tradeIsMarginal              :: TradeIsMarginalF,
-  tradeCurrency :: TradeCurrencyF,
+  tradeCurrency                :: TradeCurrencyF,
-  tradeSettleCurrency :: TradeSettleCurrencyF,
+  tradeSettleCurrency          :: TradeSettleCurrencyF,
-  tradeSettleCode :: TradeSettleCodeF,
+  tradeSettleCode              :: TradeSettleCodeF,
-  tradeAccruedInt :: TradeAccruedIntF,
+  tradeAccruedInt              :: TradeAccruedIntF,
-  tradeYield :: TradeYieldF,
+  tradeYield                   :: TradeYieldF,
-  tradeUserId :: TradeUserIdF,
+  tradeUserId                  :: TradeUserIdF,
-  tradeAccount :: TradeAccountF,
+  tradeAccount                 :: TradeAccountF,
-  tradeBrokerRef :: TradeBrokerRefF,
+  tradeBrokerRef               :: TradeBrokerRefF,
-  tradeClientCode :: TradeClientCodeF,
+  tradeClientCode              :: TradeClientCodeF,
-  tradeTsCommission :: TradeTsCommissionF,
+  tradeTsCommission            :: TradeTsCommissionF,
-  tradePeriod :: TradePeriodF,
+  tradePeriod                  :: TradePeriodF,
-  tradeDateTime :: TradeDateTimeF,
+  tradeDateTime                :: TradeDateTimeF,
-  tradeKind :: TradeKindF,
+  tradeKind                    :: TradeKindF,
-
+
-  dllHandle :: HMODULE
+  dllHandle                    :: HMODULE
 }
 
 data QuikOrder = QuikOrder {
   qoTransId :: Integer,
   qoOrderId :: Integer,
-  qoTicker :: String,
+  qoTicker  :: String,
-  qoPrice :: Double,
+  qoPrice   :: Double,
   qoBalance :: Integer,
-  qoSell :: Bool,
+  qoSell    :: Bool,
-  qoStatus :: Int
+  qoStatus  :: Int
 } deriving (Show, Eq, Ord)
 
 data QuikTrade = QuikTrade {
-  qtOrderId :: Integer,
+  qtOrderId        :: Integer,
-  qtTicker :: String,
+  qtTicker         :: String,
-  qtPrice :: Double,
+  qtPrice          :: Double,
-  qtQuantity :: Integer,
+  qtQuantity       :: Integer,
-  qtSell :: Bool,
+  qtSell           :: Bool,
-  qtVolume :: Double,
+  qtVolume         :: Double,
   qtVolumeCurrency :: String,
-  qtTimestamp :: UTCTime
+  qtTimestamp      :: UTCTime
 } deriving (Show, Eq)
 
   -- Success -> transaction id -> order num -> IO ()
 type HlTransactionCallback = Bool -> Integer -> Integer -> IO ()
-type HlOrderCallback = QuikOrder -> IO () 
+type HlOrderCallback = QuikOrder -> IO ()
 type HlTradeCallback = QuikTrade -> IO ()
 
 data Quik = Quik {
-  quikApi :: Trans2QuikApi,
+  quikApi               :: Trans2QuikApi,
 
-  connectionCallback :: FunPtr ConnectionStatusCallback,
+  connectionCallback    :: FunPtr ConnectionStatusCallback,
-  transactionCallback :: FunPtr TransactionsReplyCallback,
+  transactionCallback   :: FunPtr TransactionsReplyCallback,
-  orderCallback :: FunPtr OrderStatusCallback,
+  orderCallback         :: FunPtr OrderStatusCallback,
-  tradeCallback :: FunPtr TradeStatusCallback,
+  tradeCallback         :: FunPtr TradeStatusCallback,
 
   hlTransactionCallback :: Maybe HlTransactionCallback,
-  hlOrderCallback :: Maybe HlOrderCallback,
+  hlOrderCallback       :: Maybe HlOrderCallback,
-  hlTradeCallback :: Maybe HlTradeCallback,
+  hlTradeCallback       :: Maybe HlTradeCallback,
 
-  connectedToServer :: Bool,
+  connectedToServer     :: Bool,
-  connectedToDll :: Bool,
+  connectedToDll        :: Bool,
-  watchdogTid :: ThreadId,
+  watchdogTid           :: ThreadId,
 
-  handledTrades :: S.Set CLLong,
+  handledTrades         :: S.Set CLLong,
-  handledOrders :: S.Set QuikOrder
+  handledOrders         :: S.Set QuikOrder
 }
 
 quikSendTransaction :: IORef Quik -> String -> IO (Either T.Text ())
 quikSendTransaction state transactionString = do
   api <- quikApi <$> readIORef state
-  alloca (\errcode -> 
+  alloca (\errcode ->
     allocaBytes 1024 (\errorMsg ->
       withCString transactionString (\trs -> do
         rc <- sendAsyncTransaction api trs errcode errorMsg 1024
@@ -408,19 +408,19 @@ quikSendTransaction state transactionString = do
             msg <- peekCString errorMsg
             return $ Left $ "Unable to submit transaction: " `T.append` T.pack msg
           else return $ Right ())))
-  
+
 
 setCallbacks :: IORef Quik -> HlTransactionCallback -> HlOrderCallback -> HlTradeCallback -> IO ()
 setCallbacks quik transCb orCb tradeCb = atomicModifyIORef' quik (\s ->
     ( s { hlTransactionCallback = Just transCb,
       hlOrderCallback = Just orCb,
       hlTradeCallback = Just tradeCb }, ()))
-  
+
 
 mkQuik :: FilePath -> FilePath -> IO (IORef Quik)
 mkQuik dllpath quikpath = do
   api <- loadQuikApi dllpath
-  
+
   debugM "Quik" "Dll loaded"
 
   myTid <- myThreadId
@@ -463,13 +463,15 @@ defaultTransactionReplyCb state transactionResult errorCode replyCode transId or
   when (replyMessage /= nullPtr) $ do
     s <- convert "CP1251" "UTF-8" . BL.fromStrict <$> BS.packCString replyMessage
     case decodeUtf8' (BL.toStrict s) of
-      Left _ -> warningM "Quik" "Unable to decode utf-8"
+      Left _    -> warningM "Quik" "Unable to decode utf-8"
       Right msg -> debugM "Quik" $ "Transaction cb message:" ++ T.unpack msg
-    
+
   maybecb <- hlTransactionCallback <$> readIORef state
   case maybecb of
-    Just cb -> cb (transactionResult == ecSuccess) (toInteger transId) (toInteger orderNum)
+    Just cb -> cb ((transactionResult == ecSuccess) && (replyCode /= rcInsufficientFunds)) (toInteger transId) (toInteger orderNum)
     Nothing -> return ()
+  where
+    rcInsufficientFunds = 4
 
 defaultOrderCb :: IORef Quik -> LONG -> DWORD -> CLLong -> LPSTR -> LPSTR -> CDouble -> CLLong -> CDouble -> LONG -> LONG -> CIntPtr -> IO ()
 defaultOrderCb state mode transId dnumber classCode secCode price balance value sell status desc = do