diff --git a/app/Main.hs b/app/Main.hs index a083de2..5f55823 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -17,6 +17,7 @@ import ATrade.QuoteSource.Server import ATrade.Broker.Server import ATrade.Broker.Protocol import Broker.PaperBroker +import Broker.QuikBroker import System.Log.Logger import System.Log.Handler.Simple @@ -97,11 +98,6 @@ main = do infoM "main" "Loading config" config <- readConfig "quik-connector.config.json" - api <- runExceptT $ loadQuikApi "C:\\Program Files\\Info\\Trans2Quik.dll" - case api of - Left err -> print err - Right a -> infoM "main" "Quik API DLL loaded" - infoM "main" "Config loaded" chan <- newBoundedChan 1000 infoM "main" "Starting data import server" @@ -110,18 +106,22 @@ main = do (forkId, c1, c2) <- forkBoundedChan 1000 chan broker <- mkPaperBroker c1 1000000 ["demo"] - withContext (\ctx -> - bracket (startQuoteSourceServer c2 ctx (T.pack $ quotesourceEndpoint config)) stopQuoteSourceServer (\qsServer -> do - bracket (startBrokerServer [broker] ctx (T.pack $ brokerserverEndpoint config)) stopBrokerServer (\broServer -> do - void initGUI - window <- windowNew - window `on` deleteEvent $ do - liftIO mainQuit - return False - widgetShowAll window - mainGUI) - infoM "main" "BRS down") - ) + eitherBrokerQ <- runExceptT $ mkQuikBroker "C:\\Program Files (x86)\\Info\\Trans2Quik.dll" "C:\\Program Files (x86)\\Info" [""] + case eitherBrokerQ of + Left errmsg -> warningM "main" $ "Can't load quik broker: " ++ T.unpack errmsg + Right brokerQ -> + withContext (\ctx -> + bracket (startQuoteSourceServer c2 ctx (T.pack $ quotesourceEndpoint config)) stopQuoteSourceServer (\qsServer -> do + bracket (startBrokerServer [broker, brokerQ] ctx (T.pack $ brokerserverEndpoint config)) stopBrokerServer (\broServer -> do + void initGUI + window <- windowNew + window `on` deleteEvent $ do + liftIO mainQuit + return False + widgetShowAll window + mainGUI) + infoM "main" "BRS down") + ) killThread forkId infoM "main" "Main thread done" diff --git a/quik-connector.cabal b/quik-connector.cabal index 1cef90b..2c9fc4b 100644 --- a/quik-connector.cabal +++ b/quik-connector.cabal @@ -19,6 +19,7 @@ library , QuoteSource.TableParser , QuoteSource.TableParsers.AllParamsTableParser , Broker.PaperBroker + , Broker.QuikBroker , Broker.QuikBroker.Trans2QuikApi ghc-options: -Wincomplete-patterns build-depends: base >= 4.7 && < 5 @@ -47,6 +48,9 @@ library , libatrade , deepseq , errors + , split + , bimap + , safe default-language: Haskell2010 extra-libraries: "user32" other-modules: System.Win32.XlParser diff --git a/src/Broker/PaperBroker.hs b/src/Broker/PaperBroker.hs index eb5114a..473a779 100644 --- a/src/Broker/PaperBroker.hs +++ b/src/Broker/PaperBroker.hs @@ -35,7 +35,6 @@ data PaperBrokerState = PaperBrokerState { tickMap :: M.HashMap TickMapKey Tick, orders :: M.HashMap OrderId Order, cash :: ! Decimal, - orderIdCounter :: OrderId, notificationCallback :: Maybe (Notification -> IO ()) } @@ -47,7 +46,6 @@ mkPaperBroker tickChan startCash accounts = do tickMap = M.empty, orders = M.empty, cash = startCash, - orderIdCounter = 1, notificationCallback = Nothing } tid <- forkIO $ brokerThread state @@ -69,12 +67,6 @@ brokerThread state = do where makeKey !tick = TickMapKey (security $! tick) (datatype tick) -nextOrderId :: IORef PaperBrokerState -> IO OrderId -nextOrderId state = do - id <- orderIdCounter <$> readIORef state - modifyIORef state (\s -> s { orderIdCounter = id + 1 } ) - return id - pbSetNotificationCallback :: IORef PaperBrokerState -> Maybe (Notification -> IO ()) -> IO() pbSetNotificationCallback state callback = modifyIORef state (\s -> s { notificationCallback = callback } ) @@ -101,6 +93,7 @@ pbSubmitOrder state order = do atomicModifyIORef' state (\s -> (s { orders = M.insert (orderId order) newOrder $ orders s , cash = cash s - tradeVolume}, ()) ) ts <- getCurrentTime maybeCall notificationCallback state $ TradeNotification $ mkTrade tick order ts + maybeCall notificationCallback state $ OrderNotification (orderId order) Executed submitLimitOrder state order = warningM "PaperBroker" $ "Not implemented: Submitted order: " ++ show order submitStopOrder state order = warningM "PaperBroker" $ "Not implemented: Submitted order: " ++ show order diff --git a/src/Broker/QuikBroker.hs b/src/Broker/QuikBroker.hs index e69de29..40c08d6 100644 --- a/src/Broker/QuikBroker.hs +++ b/src/Broker/QuikBroker.hs @@ -0,0 +1,205 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MultiWayIf #-} + +module Broker.QuikBroker ( + mkQuikBroker +) where + +import ATrade.Types +import ATrade.Broker.Protocol +import ATrade.Broker.Server + +import Broker.QuikBroker.Trans2QuikApi hiding (tradeAccount) + +import Data.Decimal +import Data.IORef +import Data.List.Split +import qualified Data.List as L +import qualified Data.Map as M +import qualified Data.Bimap as BM +import qualified Data.Text as T + +import Control.Monad.Trans.Except +import Control.Monad.IO.Class +import System.Log.Logger + +import Safe + +type QuikOrderId = Integer + +data QuikBrokerState = QuikBrokerState { + notificationCallback :: Maybe (Notification -> IO ()), + quik :: IORef Quik, + orderMap :: M.Map OrderId Order, + orderIdMap :: BM.Bimap QuikOrderId OrderId, + trans2orderid :: M.Map Integer Order, + transIdCounter :: Integer +} + +nextTransId state = atomicModifyIORef' state (\s -> (s { transIdCounter = transIdCounter s + 1 }, transIdCounter s)) + +maybeCall proj state arg = do + cb <- proj <$> readIORef state + case cb of + Just callback -> callback arg + Nothing -> return () + +mkQuikBroker :: FilePath -> FilePath -> [T.Text] -> ExceptT T.Text IO BrokerInterface +mkQuikBroker dllPath quikPath accs = do + q <- mkQuik dllPath quikPath + + state <- liftIO $ newIORef QuikBrokerState { + notificationCallback = Nothing, + quik = q, + orderMap = M.empty, + orderIdMap = BM.empty, + trans2orderid = M.empty, + transIdCounter = 1 + } + + setCallbacks q (qbTransactionCallback state) (qbOrderCallback state) (qbTradeCallback state) + + return BrokerInterface { + accounts = accs, + setNotificationCallback = qbSetNotificationCallback state, + submitOrder = qbSubmitOrder state, + cancelOrder = qbCancelOrder state, + stopBroker = qbStopBroker state + } + +qbSetNotificationCallback state maybecb = atomicModifyIORef' state (\s -> (s { + notificationCallback = maybecb }, ())) + +qbSubmitOrder state order = do + q <- quik <$> readIORef state + transId <- nextTransId state + atomicModifyIORef' state (\s -> (s { + trans2orderid = M.insert transId order (trans2orderid s) }, ())) + case makeTransactionString transId order of + Just transStr -> do + rc <- quikSendTransaction q transStr + case rc of + Left errmsg -> warningM "Quik" $ "Unable to send transaction: " ++ T.unpack errmsg + Right _ -> debugM "Quik" $ "Order submitted: " ++ show order + Nothing -> warningM "Quik" $ "Unable to compose transaction string: " ++ show order + + +qbCancelOrder state orderid = do + q <- quik <$> readIORef state + transId <- nextTransId state + idMap <- orderIdMap <$> readIORef state + orders <- orderMap <$> readIORef state + case (BM.lookupR orderid idMap, M.lookup orderid orders) of + (Just quikOrderId, Just order) -> case makeCancelTransactionString transId order quikOrderId of + Just transString -> do + rc <- quikSendTransaction q transString + case rc of + Left errmsg -> warningM "Quik" ("Unable to send transaction: " ++ T.unpack errmsg) >> return False + Right _ -> debugM "Quik" ("Order cancelled: " ++ show orderid) >> return True + Nothing -> warningM "Quik" ("Unable to compose transaction string: " ++ show orderid) >> return False + _ -> warningM "Quik" ("Got request to cancel unknown order: " ++ show orderid) >> return False + +qbStopBroker state = return () + +makeTransactionString transId order = + case (classcode, seccode) of + (Just cCode, Just sCode) -> Just $ + "ACCOUNT=" ++ T.unpack (orderAccountId order) ++ ";" ++ + "TYPE=" ++ orderTypeCode ++ ";" ++ + "TRANS_ID=" ++ show transId ++ ";" ++ + "CLASSCODE=" ++ cCode ++ ";" ++ + "SECCODE=" ++ sCode ++ ";" ++ + "ACTION=NEW_ORDER;OPERATION=" ++ operationCode ++ ";" ++ + "PRICE=" ++ price ++ ";" ++ + "QUANTITY=" ++ show (orderQuantity order) ++ ";" + _ -> Nothing + where + orderTypeCode = case orderPrice order of + Market -> "M" + Limit _ -> "L" + _ -> "X" + operationCode = case orderOperation order of + Buy -> "B" + Sell -> "S" + classcode = headMay . splitOn "#" . T.unpack $ orderSecurity order + seccode = (`atMay` 1) . splitOn "#" . T.unpack $ orderSecurity order + price = case orderPrice order of + Market -> "0" + Limit p -> L.dropWhileEnd (== '.') . L.dropWhileEnd (== '0') . show $ p + _ -> "0" + +makeCancelTransactionString transId order orderId = + case (classcode, seccode) of + (Just cCode, Just sCode) -> Just $ + "TRANS_ID=" ++ show transId ++ ";" ++ + "CLASSCODE=" ++ cCode ++ ";" ++ + "SECCODE=" ++ sCode ++ ";" ++ + "ACTION=KILL_ORDER;ORDER_KEY=" ++ show orderId ++ ";" + _ -> Nothing + where + classcode = headMay . splitOn "#" . T.unpack $ orderSecurity order + seccode = (`atMay` 1) . splitOn "#" . T.unpack $ orderSecurity order + +qbTransactionCallback state success transactionId orderNum = do + t2oid <- trans2orderid <$> readIORef state + case M.lookup transactionId t2oid of + Just order -> do + atomicModifyIORef' state (\s -> (s { trans2orderid = M.delete transactionId t2oid }, ()) ) + newOrder <- if success + then registerOrder orderNum $ order { orderState = Unsubmitted } + else registerOrder orderNum $ order { orderState = Rejected } + maybeCall notificationCallback state (OrderNotification (orderId newOrder) (orderState newOrder)) + + Nothing -> return () + where + registerOrder quikOrderId order = atomicModifyIORef' state (\s -> + (s { orderIdMap = BM.insert quikOrderId (orderId order) (orderIdMap s), + orderMap = M.insert (orderId order) order (orderMap s) }, order) ) + +qbOrderCallback state quikorder = do + orders <- orderMap <$> readIORef state + idMap <- orderIdMap <$> readIORef state + debugM "Quik" $ "Order: " ++ show quikorder + case BM.lookup (qoOrderId quikorder) idMap >>= flip M.lookup orders of + Just order -> do + updatedOrder <- if | qoStatus quikorder /= 1 && qoStatus quikorder /= 2 -> + if qoBalance quikorder == 0 + then fullyExecuted order + else partiallyExecuted order (orderExecutedQuantity order - qoBalance quikorder) + | qoStatus quikorder == 1 -> + submitted order + | qoStatus quikorder == 2 -> + cancelled order + maybeCall notificationCallback state (OrderNotification (orderId updatedOrder) (orderState updatedOrder)) + Nothing -> warningM "Quik" $ "Unknown order: state callback called: " ++ show quikorder + + where + updateOrder :: Order -> IO Order + updateOrder updatedOrder = + atomicModifyIORef' state (\s -> (s { orderMap = M.insert (orderId updatedOrder) updatedOrder (orderMap s)}, updatedOrder)) + + fullyExecuted order = updateOrder $ order { orderState = Executed, orderExecutedQuantity = orderQuantity order } + partiallyExecuted order quan = updateOrder $ order { orderState = PartiallyExecuted, orderExecutedQuantity = quan } + submitted order = updateOrder $ order { orderState = Submitted } + cancelled order = updateOrder $ order { orderState = Cancelled } + +qbTradeCallback state quiktrade = do + orders <- orderMap <$> readIORef state + idMap <- orderIdMap <$> readIORef state + debugM "Quik" $ "Trade: " ++ show quiktrade + case BM.lookup (qtOrderId quiktrade) idMap >>= flip M.lookup orders of + Just order -> maybeCall notificationCallback state (TradeNotification $ tradeFor order) + Nothing -> warningM "Quik" $ "Incoming trade for unknown order: " ++ show quiktrade + where + tradeFor order = Trade { + tradeOrderId = orderId order, + tradePrice = realFracToDecimal 10 $ qtPrice quiktrade, + tradeQuantity = qtQuantity quiktrade, + tradeVolume = realFracToDecimal 10 $ qtVolume quiktrade, + tradeVolumeCurrency = T.pack $ qtVolumeCurrency quiktrade, + tradeOperation = if qtSell quiktrade then Sell else Buy, + tradeAccount = orderAccountId order, + tradeSecurity = orderSecurity order, + tradeTimestamp = qtTimestamp quiktrade, + tradeSignalId = orderSignalId order } + diff --git a/src/Broker/QuikBroker/Trans2QuikApi.hs b/src/Broker/QuikBroker/Trans2QuikApi.hs index 806d5d7..6ade1ea 100644 --- a/src/Broker/QuikBroker/Trans2QuikApi.hs +++ b/src/Broker/QuikBroker/Trans2QuikApi.hs @@ -2,13 +2,20 @@ module Broker.QuikBroker.Trans2QuikApi ( Trans2QuikApi(..), - loadQuikApi + loadQuikApi, + Quik(..), + setCallbacks, + mkQuik, + QuikOrder(..), + QuikTrade(..), + quikSendTransaction ) where import Foreign import Foreign.C.Types import Foreign.C.String import Foreign.Marshal.Array +import Control.Monad import Control.Monad.Trans.Except import Control.Error.Util import Control.Monad.IO.Class @@ -16,256 +23,264 @@ import System.Win32.DLL import System.Win32.Types import Control.Concurrent import Data.IORef +import Data.Time.Clock +import Data.Time.Calendar +import Data.Ratio +import qualified Data.Set as S import qualified Data.Text as T - -EcSuccess = 0 -EcFailed = 1 -EcQuikTerminalNotFound = 2 -EcDllVersionNotSupported = 3 -EcAlreadyConnectedToQuik = 4 -EcWrongSyntax = 5 -EcQuikNotConnected = 6 -EcDllNotConnected = 7 -EcQuikConnected = 8 -EcQuikDisconnected = 9 -EcDllConnected = 10 -EcDllDisconnected = 11 -EcMemoryAllocationError = 12 -EcWrongConnectionHandle = 13 -EcWrongInputParams = 14 +import System.Log.Logger + +ecSuccess = 0 +ecFailed = 1 +ecQuikTerminalNotFound = 2 +ecDllVersionNotSupported = 3 +ecAlreadyConnectedToQuik = 4 +ecWrongSyntax = 5 +ecQuikNotConnected = 6 +ecDllNotConnected = 7 +ecQuikConnected = 8 +ecQuikDisconnected = 9 +ecDllConnected = 10 +ecDllDisconnected = 11 +ecMemoryAllocationError = 12 +ecWrongConnectionHandle = 13 +ecWrongInputParams = 14 type ConnectF = LPCSTR -> Ptr LONG -> LPSTR -> DWORD -> IO LONG -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkConnectFun :: FunPtr ConnectF -> ConnectF type DisconnectF = Ptr LONG -> LPSTR -> DWORD -> IO LONG -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkDisconnectFun :: FunPtr DisconnectF -> DisconnectF type IsQuikConnectedF = Ptr LONG -> LPSTR -> DWORD -> IO LONG -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkIsQuikConnectedFun :: FunPtr IsQuikConnectedF -> IsQuikConnectedF type IsDllConnectedF = Ptr LONG -> LPSTR -> DWORD -> IO LONG -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkIsDllConnectedFun :: FunPtr IsDllConnectedF -> IsDllConnectedF type SendSyncTransactionF = LPSTR -> Ptr LONG -> Ptr LONG -> Ptr CDouble -> LPSTR -> DWORD -> Ptr LONG -> LPSTR -> DWORD -> IO LONG -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkSendSyncTransactionFun :: FunPtr SendSyncTransactionF -> SendSyncTransactionF type SendAsyncTransactionF = LPSTR -> Ptr LONG -> LPSTR -> DWORD -> IO LONG -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkSendAsyncTransactionFun :: FunPtr SendAsyncTransactionF -> SendAsyncTransactionF type ConnectionStatusCallback = LONG -> LONG -> LPSTR -> IO () -foreign import ccall "wrapper" +foreign import stdcall "wrapper" mkConnectionStatusCallback :: ConnectionStatusCallback -> IO (FunPtr ConnectionStatusCallback) type SetConnectionStatusCallbackF = FunPtr ConnectionStatusCallback -> Ptr LONG -> LPSTR -> DWORD -> IO LONG -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkSetConnectionStatusCallbackFun :: FunPtr SetConnectionStatusCallbackF -> SetConnectionStatusCallbackF -type TransactionsReplyCallback = LONG -> LONG -> LONG -> DWORD -> CDouble -> LPSTR -> IO () -foreign import ccall "wrapper" +type TransactionsReplyCallback = LONG -> LONG -> LONG -> DWORD -> CLLong -> LPSTR -> CIntPtr -> IO () +foreign import stdcall "wrapper" mkTransactionsReplyCallback :: TransactionsReplyCallback -> IO (FunPtr TransactionsReplyCallback) type SetTransactionsReplyCallbackF = FunPtr TransactionsReplyCallback -> Ptr LONG -> LPSTR -> DWORD -> IO LONG -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkSetTransactionsReplyCallbackFun :: FunPtr SetTransactionsReplyCallbackF -> SetTransactionsReplyCallbackF -type OrderStatusCallback = LONG -> DWORD -> CDouble -> LPSTR -> LPSTR -> CDouble -> LONG -> CDouble -> LONG -> LONG -> LONG -> IO () -foreign import ccall "wrapper" +type OrderStatusCallback = LONG -> DWORD -> CLLong -> LPSTR -> LPSTR -> CDouble -> CLLong -> CDouble -> LONG -> LONG -> CIntPtr -> IO () +foreign import stdcall "wrapper" mkOrderStatusCallback :: OrderStatusCallback -> IO (FunPtr OrderStatusCallback) -type TradeStatusCallback = LONG -> CDouble -> CDouble -> LPSTR -> LPSTR -> CDouble -> LONG -> CDouble -> LONG -> LONG -> IO () -foreign import ccall "wrapper" +type TradeStatusCallback = LONG -> CLLong -> CLLong -> LPSTR -> LPSTR -> CDouble -> CLLong -> CDouble -> LONG -> CIntPtr -> IO () +foreign import stdcall "wrapper" mkTradeStatusCallback :: TradeStatusCallback -> IO (FunPtr TradeStatusCallback) type SubscribeOrdersF = LPSTR -> LPSTR -> IO LONG -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkSubscribeOrdersFun :: FunPtr SubscribeOrdersF -> SubscribeOrdersF type SubscribeTradesF = LPSTR -> LPSTR -> IO LONG -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkSubscribeTradesFun :: FunPtr SubscribeTradesF -> SubscribeTradesF type StartOrdersF = FunPtr OrderStatusCallback -> IO () -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkStartOrdersFun :: FunPtr StartOrdersF -> StartOrdersF type StartTradesF = FunPtr TradeStatusCallback -> IO () -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkStartTradesFun :: FunPtr StartTradesF -> StartTradesF type UnsubscribeOrdersF = IO LONG -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkUnsubscribeOrdersFun :: FunPtr UnsubscribeOrdersF -> UnsubscribeOrdersF type UnsubscribeTradesF = IO LONG -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkUnsubscribeTradesFun :: FunPtr UnsubscribeTradesF -> UnsubscribeTradesF -- Order requests type OrderQtyF = LONG -> IO LONG -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkOrderQtyFun :: FunPtr OrderQtyF -> OrderQtyF type OrderDateF = LONG -> IO LONG -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkOrderDateFun :: FunPtr OrderDateF -> OrderDateF type OrderTimeF = LONG -> IO LONG -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkOrderTimeFun :: FunPtr OrderTimeF -> OrderTimeF type OrderActivationTimeF = LONG -> IO LONG -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkOrderActivationTimeFun :: FunPtr OrderActivationTimeF -> OrderActivationTimeF type OrderWithdrawTimeF = LONG -> IO LONG -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkOrderWithdrawTimeFun :: FunPtr OrderWithdrawTimeF -> OrderWithdrawTimeF type OrderExpiryF = LONG -> IO LONG -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkOrderExpiryFun :: FunPtr OrderExpiryF -> OrderExpiryF type OrderAccruedIntF = LONG -> IO CDouble -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkOrderAccruedIntFun :: FunPtr OrderAccruedIntF -> OrderAccruedIntF type OrderYieldF = LONG -> IO CDouble -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkOrderYieldFun :: FunPtr OrderYieldF -> OrderYieldF type OrderUserIdF = LONG -> IO LPSTR -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkOrderUserIdFun :: FunPtr OrderUserIdF -> OrderUserIdF type OrderUidF = LONG -> IO LONG -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkOrderUidFun :: FunPtr OrderUidF -> OrderUidF type OrderAccountF = LONG -> IO LPSTR -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkOrderAccountFun :: FunPtr OrderAccountF -> OrderAccountF type OrderBrokerRefF = LONG -> IO LPSTR -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkOrderBrokerRefFun :: FunPtr OrderBrokerRefF -> OrderBrokerRefF type OrderClientCodeF = LONG -> IO LPSTR -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkOrderClientCodeFun :: FunPtr OrderClientCodeF -> OrderClientCodeF type OrderFirmIdF = LONG -> IO LPSTR -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkOrderFirmIdFun :: FunPtr OrderFirmIdF -> OrderFirmIdF type OrderVisibleQtyF = LONG -> IO LONG -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkOrderVisibleQtyFun :: FunPtr OrderVisibleQtyF -> OrderVisibleQtyF type OrderPeriodF = LONG -> IO LONG -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkOrderPeriodFun :: FunPtr OrderPeriodF -> OrderPeriodF type OrderDateTimeF = LONG -> LONG -> IO LONG -foreign import ccall "dynamic" +foreign import stdcall "dynamic" mkOrderDateTimeFun :: FunPtr OrderDateTimeF -> OrderDateTimeF -- Trade requests -type TradeDateF = LONG -> IO LONG -foreign import ccall "dynamic" +type TradeDateF = CIntPtr -> IO LONG +foreign import stdcall "dynamic" mkTradeDateFun :: FunPtr TradeDateF -> TradeDateF -type TradeSettleDateF = LONG -> IO LONG -foreign import ccall "dynamic" +type TradeSettleDateF = CIntPtr -> IO LONG +foreign import stdcall "dynamic" mkTradeSettleDateFun :: FunPtr TradeSettleDateF -> TradeSettleDateF -type TradeTimeF = LONG -> IO LONG -foreign import ccall "dynamic" +type TradeTimeF = CIntPtr -> IO LONG +foreign import stdcall "dynamic" mkTradeTimeFun :: FunPtr TradeTimeF -> TradeTimeF -type TradeIsMarginalF = LONG -> IO LONG -foreign import ccall "dynamic" +type TradeIsMarginalF = CIntPtr -> IO LONG +foreign import stdcall "dynamic" mkTradeIsMarginalFun :: FunPtr TradeIsMarginalF -> TradeIsMarginalF -type TradeCurrencyF = LONG -> IO LPSTR -foreign import ccall "dynamic" +type TradeCurrencyF = CIntPtr -> IO LPSTR +foreign import stdcall "dynamic" mkTradeCurrencyFun :: FunPtr TradeCurrencyF -> TradeCurrencyF -type TradeSettleCurrencyF = LONG -> IO LPSTR -foreign import ccall "dynamic" +type TradeSettleCurrencyF = CIntPtr -> IO LPSTR +foreign import stdcall "dynamic" mkTradeSettleCurrencyFun :: FunPtr TradeSettleCurrencyF -> TradeSettleCurrencyF -type TradeSettleCodeF = LONG -> IO LPSTR -foreign import ccall "dynamic" +type TradeSettleCodeF = CIntPtr -> IO LPSTR +foreign import stdcall "dynamic" mkTradeSettleCodeFun :: FunPtr TradeSettleCodeF -> TradeSettleCodeF -type TradeAccruedIntF = LONG -> IO CDouble -foreign import ccall "dynamic" +type TradeAccruedIntF = CIntPtr -> IO CDouble +foreign import stdcall "dynamic" mkTradeAccruedIntFun :: FunPtr TradeAccruedIntF -> TradeAccruedIntF -type TradeYieldF = LONG -> IO CDouble -foreign import ccall "dynamic" +type TradeYieldF = CIntPtr -> IO CDouble +foreign import stdcall "dynamic" mkTradeYieldFun :: FunPtr TradeYieldF -> TradeYieldF -type TradeUserIdF = LONG -> IO LPSTR -foreign import ccall "dynamic" +type TradeUserIdF = CIntPtr -> IO LPSTR +foreign import stdcall "dynamic" mkTradeUserIdFun :: FunPtr TradeUserIdF -> TradeUserIdF -type TradeAccountF = LONG -> IO LPSTR -foreign import ccall "dynamic" +type TradeAccountF = CIntPtr -> IO LPSTR +foreign import stdcall "dynamic" mkTradeAccountFun :: FunPtr TradeAccountF -> TradeAccountF -type TradeBrokerRefF = LONG -> IO LPSTR -foreign import ccall "dynamic" +type TradeBrokerRefF = CIntPtr -> IO LPSTR +foreign import stdcall "dynamic" mkTradeBrokerRefFun :: FunPtr TradeBrokerRefF -> TradeBrokerRefF -type TradeClientCodeF = LONG -> IO LPSTR -foreign import ccall "dynamic" +type TradeClientCodeF = CIntPtr -> IO LPSTR +foreign import stdcall "dynamic" mkTradeClientCodeFun :: FunPtr TradeClientCodeF -> TradeClientCodeF -type TradeFirmIdF = LONG -> IO LPSTR -foreign import ccall "dynamic" +type TradeFirmIdF = CIntPtr -> IO LPSTR +foreign import stdcall "dynamic" mkTradeFirmIdFun :: FunPtr TradeFirmIdF -> TradeFirmIdF -type TradePartnerFirmIdF = LONG -> IO LPSTR -foreign import ccall "dynamic" +type TradePartnerFirmIdF = CIntPtr -> IO LPSTR +foreign import stdcall "dynamic" mkTradePartnerFirmIdFun :: FunPtr TradePartnerFirmIdF -> TradePartnerFirmIdF -type TradeTsCommissionF = LONG -> IO CDouble -foreign import ccall "dynamic" +type TradeTsCommissionF = CIntPtr -> IO CDouble +foreign import stdcall "dynamic" mkTradeTsCommissionFun :: FunPtr TradeTsCommissionF -> TradeTsCommissionF -type TradeClearingCenterCommissionF = LONG -> IO CDouble -foreign import ccall "dynamic" +type TradeClearingCenterCommissionF = CIntPtr -> IO CDouble +foreign import stdcall "dynamic" mkTradeClearingCenterCommissionFun :: FunPtr TradeClearingCenterCommissionF -> TradeClearingCenterCommissionF -type TradeExchangeCommissionF = LONG -> IO CDouble -foreign import ccall "dynamic" +type TradeExchangeCommissionF = CIntPtr -> IO CDouble +foreign import stdcall "dynamic" mkTradeExchangeCommissionFun :: FunPtr TradeExchangeCommissionF -> TradeExchangeCommissionF -type TradeTradingSystemCommissionF = LONG -> IO CDouble -foreign import ccall "dynamic" +type TradeTradingSystemCommissionF = CIntPtr -> IO CDouble +foreign import stdcall "dynamic" mkTradeTradingSystemCommissionFun :: FunPtr TradeTradingSystemCommissionF -> TradeTradingSystemCommissionF -type TradePeriodF = LONG -> IO LONG -foreign import ccall "dynamic" +type TradePeriodF = CIntPtr -> IO LONG +foreign import stdcall "dynamic" mkTradePeriodFun :: FunPtr TradePeriodF -> TradePeriodF -type TradeDateTimeF = LONG -> IO LONG -foreign import ccall "dynamic" +type TradeDateTimeF = CIntPtr -> LONG -> IO LONG +foreign import stdcall "dynamic" mkTradeDateTimeFun :: FunPtr TradeDateTimeF -> TradeDateTimeF -type TradeKindF = LONG -> IO LONG -foreign import ccall "dynamic" +type TradeKindF = CIntPtr -> IO LONG +foreign import stdcall "dynamic" mkTradeKindFun :: FunPtr TradeKindF -> TradeKindF +toDouble :: CDouble -> Double +toDouble (CDouble x) = x + data Trans2QuikApi = Trans2QuikApi { connect :: ConnectF, disconnect :: DisconnectF, @@ -321,6 +336,32 @@ data Trans2QuikApi = Trans2QuikApi { dllHandle :: HMODULE } +data QuikOrder = QuikOrder { + qoTransId :: Integer, + qoOrderId :: Integer, + qoTicker :: String, + qoPrice :: Double, + qoBalance :: Integer, + qoSell :: Bool, + qoStatus :: Int +} deriving (Show, Eq, Ord) + +data QuikTrade = QuikTrade { + qtOrderId :: Integer, + qtTicker :: String, + qtPrice :: Double, + qtQuantity :: Integer, + qtSell :: Bool, + qtVolume :: Double, + qtVolumeCurrency :: String, + qtTimestamp :: UTCTime +} deriving (Show, Eq) + + -- Success -> transaction id -> order num -> IO () +type HlTransactionCallback = Bool -> Integer -> Integer -> IO () +type HlOrderCallback = QuikOrder -> IO () +type HlTradeCallback = QuikTrade -> IO () + data Quik = Quik { quikApi :: Trans2QuikApi, @@ -329,104 +370,237 @@ data Quik = Quik { orderCallback :: FunPtr OrderStatusCallback, tradeCallback :: FunPtr TradeStatusCallback, + hlTransactionCallback :: Maybe HlTransactionCallback, + hlOrderCallback :: Maybe HlOrderCallback, + hlTradeCallback :: Maybe HlTradeCallback, + connected :: Bool, - watchdogTid :: ThreadId + watchdogTid :: ThreadId, + + handledTrades :: S.Set CLLong, + handledOrders :: S.Set QuikOrder } -mkQuik :: FilePath -> FilePath -> ConnectionStatusCallback -> TransactionsReplyCallback -> OrderStatusCallback -> TradeStatusCallback -> ExceptT T.Text IO (IORef Quik) -mkQuik dllpath quikpath conncb transcb orcb tradecb = do +quikSendTransaction :: IORef Quik -> String -> IO (Either T.Text ()) +quikSendTransaction state transactionString = do + api <- quikApi <$> readIORef state + alloca (\errcode -> + allocaBytes 1024 (\errorMsg -> + withCString transactionString (\trs -> do + rc <- sendAsyncTransaction api trs errcode errorMsg 1024 + if rc /= ecSuccess + then do + msg <- peekCString errorMsg + return $ Left $ "Unable to submit transaction: " `T.append` T.pack msg + else return $ Right ()))) + + +setCallbacks :: IORef Quik -> HlTransactionCallback -> HlOrderCallback -> HlTradeCallback -> ExceptT T.Text IO () +setCallbacks quik transCb orCb tradeCb = + liftIO $ atomicModifyIORef' quik (\s -> + ( s { hlTransactionCallback = Just transCb, + hlOrderCallback = Just orCb, + hlTradeCallback = Just tradeCb }, ())) + + +mkQuik :: FilePath -> FilePath -> ExceptT T.Text IO (IORef Quik) +mkQuik dllpath quikpath = do api <- loadQuikApi dllpath - - conncb' <- liftIO (mkConnectionStatusCallback conncb) - transcb' <- liftIO (mkTransactionsReplyCallback transcb) - orcb' <- liftIO (mkOrderStatusCallback orcb) - tradecb' <- liftIO (mkTradeStatusCallback tradecb) + + liftIO $ debugM "Quik" "Dll loaded" myTid <- liftIO myThreadId state <- liftIO $ newIORef Quik { quikApi = api, - connectionCallback = conncb', + connected = False, + watchdogTid = myTid, + hlTransactionCallback = Nothing, + hlOrderCallback = Nothing, + hlTradeCallback = Nothing, + handledTrades = S.empty, + handledOrders = S.empty } + + conncb' <- liftIO (mkConnectionStatusCallback (defaultConnectionCb state)) + transcb' <- liftIO (mkTransactionsReplyCallback (defaultTransactionReplyCb state)) + orcb' <- liftIO (mkOrderStatusCallback (defaultOrderCb state)) + tradecb' <- liftIO (mkTradeStatusCallback (defaultTradeCb state)) + + liftIO (atomicModifyIORef' state (\s -> (s { connectionCallback = conncb', transactionCallback = transcb', orderCallback = orcb', - tradeCallback = tradecb', - connected = False, - watchdogTid = myTid } + tradeCallback = tradecb' }, ()))) tid <- liftIO (forkIO $ watchdog quikpath state) - liftIO $ atomicModifyIORef' (\s -> s { watchdogTid = tid }) + liftIO $ atomicModifyIORef' state (\s -> (s { watchdogTid = tid }, ())) + liftIO $ debugM "Quik" "mkQuik done" return state +defaultConnectionCb :: IORef Quik -> LONG -> LONG -> LPSTR -> IO () +defaultConnectionCb state event errorCode infoMessage + | event == ecDllConnected || event == ecQuikConnected = infoM "Quik" "Quik connected" >> atomicModifyIORef' state (\s -> (s { connected = True }, ()) ) + | event == ecQuikDisconnected = infoM "Quik" "Quik disconnected" >> atomicModifyIORef' state (\s -> (s { connected = False }, ()) ) + | otherwise = debugM "Quik" $ "Connection event: " ++ show event + +defaultTransactionReplyCb :: IORef Quik -> LONG -> LONG -> LONG -> DWORD -> CLLong -> LPSTR -> CIntPtr -> IO () +defaultTransactionReplyCb state transactionResult errorCode replyCode transId orderNum replyMessage replyDesc = do + maybecb <- hlTransactionCallback <$> readIORef state + case maybecb of + Just cb -> cb (transactionResult == ecSuccess) (toInteger transId) (toInteger orderNum) + Nothing -> return () + +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 + orders <- handledOrders <$> readIORef state + when (mode == 0) $ do + maybecb <- hlOrderCallback <$> readIORef state + ssec <- peekCString secCode + sclass <- peekCString classCode + let order = mkOrder sclass ssec + when (order `S.notMember` orders) $ do + atomicModifyIORef' state (\s -> (s { handledOrders = S.insert order (handledOrders s) }, ())) + case maybecb of + Just cb -> cb order + Nothing -> return () + where + mkOrder :: String -> String -> QuikOrder + mkOrder sclass ssec = QuikOrder { + qoTransId = toInteger transId, + qoOrderId = toInteger dnumber, + qoTicker = sclass ++ "#" ++ ssec, + qoPrice = toDouble price, + qoBalance = toInteger balance, + qoSell = sell == 1, + qoStatus = fromIntegral status + } + +defaultTradeCb :: IORef Quik -> LONG -> CLLong -> CLLong -> LPSTR -> LPSTR -> CDouble -> CLLong -> CDouble -> LONG -> CIntPtr -> IO () +defaultTradeCb state mode dnumber orderNum classCode secCode price qty value sell desc = do + trades <- handledTrades <$> readIORef state + when (mode == 0 && dnumber `S.notMember` trades) $ do + atomicModifyIORef' state (\s -> (s { handledTrades = S.insert dnumber (handledTrades s) }, ())) + api <- quikApi <$> readIORef state + maybecb <- hlTradeCallback <$> readIORef state + case maybecb of + Just cb -> do + ssec <- peekCString secCode + sclass <- peekCString classCode + ymd <- toInteger <$> tradeDateTime api desc 0 + hms <- toInteger <$> tradeDateTime api desc 1 + us <- toInteger <$> tradeDateTime api desc 2 + currency <- tradeCurrency api desc >>= peekCString + cb (trade ssec sclass ymd hms us currency) + Nothing -> return () + where + trade ssec sclass ymd hms us currency = QuikTrade { + qtOrderId = toInteger orderNum, + qtTicker = sclass ++ "#" ++ ssec, + qtPrice = toDouble price, + qtQuantity = toInteger qty, + qtSell = sell == 1, + qtVolume = toDouble value, + qtVolumeCurrency = currency, + qtTimestamp = mkTimestamp ymd hms us + } + mkTimestamp ymd hms us = UTCTime (fromGregorian y mon d) (fromInteger (h * 3600 + m * 60 + s) + fromRational (us % 1000000)) + where + y = ymd `div` 10000 + mon = fromEnum $ (ymd `mod` 10000) `div` 100 + d = fromEnum $ ymd `mod` 100 + h = hms `div` 10000 + m = (hms `mod` 10000) `div` 100 + s = hms `mod` 100 + + watchdog :: FilePath -> IORef Quik -> IO () watchdog quikpath state = do api <- quikApi <$> readIORef state conncb <- connectionCallback <$> readIORef state + transcb <- transactionCallback <$> readIORef state + orcb <- orderCallback <$> readIORef state + tradecb <- tradeCallback <$> readIORef state alloca (\errorCode -> allocaBytes 1024 (\errorMsg -> do - err <- setConnectionStatusCallback api $ conncb errorCode errorMsg 1024 - if err /= EcSuccess + err <- setConnectionStatusCallback api conncb errorCode errorMsg 1024 + if err /= ecSuccess then warningM "Quik.Watchdog" $ "Error: " ++ show err else forever $ do conn <- connected <$> readIORef state unless conn $ withCString quikpath (\path -> do - err <- connect api $ path errorCode errorMsg 1024 - when (err /= EcSuccess) $ warningM "Quik.Watchdog" $ "Unable to connect: " ++ show err) + err <- connect api path errorCode errorMsg 1024 + if err /= ecSuccess + then warningM "Quik.Watchdog" $ "Unable to connect: " ++ show err + else withCString "" (\emptyStr -> do + (runExceptT $ do + throwIfErr $ setTransactionsReplyCallback api transcb errorCode errorMsg 1024 + throwIfErr $ subscribeOrders api emptyStr emptyStr + liftIO $ startOrders api orcb + throwIfErr $ subscribeTrades api emptyStr emptyStr + liftIO $ startTrades api tradecb) + return ())) threadDelay 5000000)) +throwIfErr :: IO LONG -> ExceptT T.Text IO () +throwIfErr action = do + rc <- liftIO action + if rc /= ecSuccess + then throwE "Error" + else return () + loadQuikApi :: FilePath -> ExceptT T.Text IO Trans2QuikApi loadQuikApi path = do dll <- castPtr <$> liftIO (loadLibrary path) dll `orFail` "Unable to load Trans2quik.dll" - connectPtr <- mkConnectFun <$> tryLoad dll "_TRANS2QUIK_CONNECT@16" - disconnectPtr <- mkDisconnectFun <$> tryLoad dll "_TRANS2QUIK_DISCONNECT@12" - isQuikConnectedPtr <- mkIsQuikConnectedFun <$> tryLoad dll "_TRANS2QUIK_IS_QUIK_CONNECTED@12" - isDllConnectedPtr <- mkIsDllConnectedFun <$> tryLoad dll "_TRANS2QUIK_IS_DLL_CONNECTED@12" - sendSyncTransactionPtr <- mkSendSyncTransactionFun <$> tryLoad dll "_TRANS2QUIK_SEND_SYNC_TRANSACTION@36" - sendAsyncTransactionPtr <- mkSendAsyncTransactionFun <$> tryLoad dll "_TRANS2QUIK_SEND_ASYNC_TRANSACTION@16" - setConnectionStatusCallbackPtr <- mkSetConnectionStatusCallbackFun <$> tryLoad dll "_TRANS2QUIK_SET_CONNECTION_STATUS_CALLBACK@16" - setTransactionsReplyCallbackPtr <- mkSetTransactionsReplyCallbackFun <$> tryLoad dll "_TRANS2QUIK_SET_TRANSACTIONS_REPLY_CALLBACK@16" - subscribeOrdersPtr <- mkSubscribeOrdersFun <$> tryLoad dll "_TRANS2QUIK_SUBSCRIBE_ORDERS@8" - subscribeTradesPtr <- mkSubscribeTradesFun <$> tryLoad dll "_TRANS2QUIK_SUBSCRIBE_TRADES@8" - startOrdersPtr <- mkStartOrdersFun <$> tryLoad dll "_TRANS2QUIK_START_ORDERS@4" - startTradesPtr <- mkStartTradesFun <$> tryLoad dll "_TRANS2QUIK_START_TRADES@4" - unsubscribeOrdersPtr <- mkUnsubscribeOrdersFun <$> tryLoad dll "_TRANS2QUIK_UNSUBSCRIBE_ORDERS@0" - unsubscribeTradesPtr <- mkUnsubscribeTradesFun <$> tryLoad dll "_TRANS2QUIK_UNSUBSCRIBE_TRADES@0" - - orderQtyPtr <- mkOrderQtyFun <$> tryLoad dll "_TRANS2QUIK_ORDER_QTY@4" - orderDatePtr <- mkOrderDateFun <$> tryLoad dll "_TRANS2QUIK_ORDER_DATE@4" - orderTimePtr <- mkOrderTimeFun <$> tryLoad dll "_TRANS2QUIK_ORDER_TIME@4" - orderActivationTimePtr <- mkOrderActivationTimeFun <$> tryLoad dll "_TRANS2QUIK_ORDER_ACTIVATION_TIME@4" - orderWithdrawTimePtr <- mkOrderWithdrawTimeFun <$> tryLoad dll "_TRANS2QUIK_ORDER_WITHDRAW_TIME@4" - orderExpiryPtr <- mkOrderExpiryFun <$> tryLoad dll "_TRANS2QUIK_ORDER_EXPIRY@4" - orderAccruedIntPtr <- mkOrderAccruedIntFun <$> tryLoad dll "_TRANS2QUIK_ORDER_ACCRUED_INT@4" - orderYieldPtr <- mkOrderYieldFun <$> tryLoad dll "_TRANS2QUIK_ORDER_YIELD@4" - orderUserIdPtr <- mkOrderUserIdFun <$> tryLoad dll "_TRANS2QUIK_ORDER_USERID@4" - orderUidPtr <- mkOrderUidFun <$> tryLoad dll "_TRANS2QUIK_ORDER_UID@4" - orderAccountPtr <- mkOrderAccountFun <$> tryLoad dll "_TRANS2QUIK_ORDER_ACCOUNT@4" - orderBrokerRefPtr <- mkOrderBrokerRefFun <$> tryLoad dll "_TRANS2QUIK_ORDER_BROKERREF@4" - orderClientCodePtr <- mkOrderClientCodeFun <$> tryLoad dll "_TRANS2QUIK_ORDER_CLIENT_CODE@4" - orderFirmIdPtr <- mkOrderFirmIdFun <$> tryLoad dll "_TRANS2QUIK_ORDER_FIRMID@4" - orderVisibleQtyPtr <- mkOrderVisibleQtyFun <$> tryLoad dll "_TRANS2QUIK_ORDER_VISIBLE_QTY@4" - orderPeriodPtr <- mkOrderPeriodFun <$> tryLoad dll "_TRANS2QUIK_ORDER_PERIOD@4" - orderDateTimePtr <- mkOrderDateTimeFun <$> tryLoad dll "_TRANS2QUIK_ORDER_DATE_TIME@8" - - tradeDatePtr <- mkTradeDateFun <$> tryLoad dll "_TRANS2QUIK_TRADE_DATE@4" - tradeSettleDatePtr <- mkTradeSettleDateFun <$> tryLoad dll "_TRANS2QUIK_TRADE_SETTLE_DATE@4" - tradeTimePtr <- mkTradeTimeFun <$> tryLoad dll "_TRANS2QUIK_TRADE_TIME@4" - tradeIsMarginalPtr <- mkTradeIsMarginalFun <$> tryLoad dll "_TRANS2QUIK_TRADE_IS_MARGINAL@4" - tradeCurrencyPtr <- mkTradeCurrencyFun <$> tryLoad dll "_TRANS2QUIK_TRADE_CURRENCY@4" - tradeSettleCurrencyPtr <- mkTradeSettleCurrencyFun <$> tryLoad dll "_TRANS2QUIK_TRADE_SETTLE_CURRENCY@4" - tradeSettleCodePtr <- mkTradeSettleCodeFun <$> tryLoad dll "_TRANS2QUIK_TRADE_SETTLE_CODE@4" - tradeAccruedIntPtr <- mkTradeAccruedIntFun <$> tryLoad dll "_TRANS2QUIK_TRADE_ACCRUED_INT@4" - tradeYieldPtr <- mkTradeYieldFun <$> tryLoad dll "_TRANS2QUIK_TRADE_YIELD@4" - tradeUserIdPtr <- mkTradeUserIdFun <$> tryLoad dll "_TRANS2QUIK_TRADE_USERID@4" - tradeAccountPtr <- mkTradeAccountFun <$> tryLoad dll "_TRANS2QUIK_TRADE_ACCOUNT@4" - tradeBrokerRefPtr <- mkTradeBrokerRefFun <$> tryLoad dll "_TRANS2QUIK_TRADE_BROKERREF@4" - tradeClientCodePtr <- mkTradeClientCodeFun <$> tryLoad dll "_TRANS2QUIK_TRADE_CLIENT_CODE@4" - tradeTsCommissionPtr <- mkTradeTsCommissionFun <$> tryLoad dll "_TRANS2QUIK_TRADE_TS_COMMISSION@4" - tradePeriodPtr <- mkTradePeriodFun <$> tryLoad dll "_TRANS2QUIK_TRADE_PERIOD@4" - tradeDateTimePtr <- mkTradeDateTimeFun <$> tryLoad dll "_TRANS2QUIK_TRADE_DATE_TIME@8" - tradeKindPtr <- mkTradeKindFun <$> tryLoad dll "_TRANS2QUIK_TRADE_KIND@4" + connectPtr <- mkConnectFun <$> tryLoad dll "TRANS2QUIK_CONNECT" + disconnectPtr <- mkDisconnectFun <$> tryLoad dll "TRANS2QUIK_DISCONNECT" + isQuikConnectedPtr <- mkIsQuikConnectedFun <$> tryLoad dll "TRANS2QUIK_IS_QUIK_CONNECTED" + isDllConnectedPtr <- mkIsDllConnectedFun <$> tryLoad dll "TRANS2QUIK_IS_DLL_CONNECTED" + sendSyncTransactionPtr <- mkSendSyncTransactionFun <$> tryLoad dll "TRANS2QUIK_SEND_SYNC_TRANSACTION" + sendAsyncTransactionPtr <- mkSendAsyncTransactionFun <$> tryLoad dll "TRANS2QUIK_SEND_ASYNC_TRANSACTION" + setConnectionStatusCallbackPtr <- mkSetConnectionStatusCallbackFun <$> tryLoad dll "TRANS2QUIK_SET_CONNECTION_STATUS_CALLBACK" + setTransactionsReplyCallbackPtr <- mkSetTransactionsReplyCallbackFun <$> tryLoad dll "TRANS2QUIK_SET_TRANSACTIONS_REPLY_CALLBACK" + subscribeOrdersPtr <- mkSubscribeOrdersFun <$> tryLoad dll "TRANS2QUIK_SUBSCRIBE_ORDERS" + subscribeTradesPtr <- mkSubscribeTradesFun <$> tryLoad dll "TRANS2QUIK_SUBSCRIBE_TRADES" + startOrdersPtr <- mkStartOrdersFun <$> tryLoad dll "TRANS2QUIK_START_ORDERS" + startTradesPtr <- mkStartTradesFun <$> tryLoad dll "TRANS2QUIK_START_TRADES" + unsubscribeOrdersPtr <- mkUnsubscribeOrdersFun <$> tryLoad dll "TRANS2QUIK_UNSUBSCRIBE_ORDERS" + unsubscribeTradesPtr <- mkUnsubscribeTradesFun <$> tryLoad dll "TRANS2QUIK_UNSUBSCRIBE_TRADES" + + orderQtyPtr <- mkOrderQtyFun <$> tryLoad dll "TRANS2QUIK_ORDER_QTY" + orderDatePtr <- mkOrderDateFun <$> tryLoad dll "TRANS2QUIK_ORDER_DATE" + orderTimePtr <- mkOrderTimeFun <$> tryLoad dll "TRANS2QUIK_ORDER_TIME" + orderActivationTimePtr <- mkOrderActivationTimeFun <$> tryLoad dll "TRANS2QUIK_ORDER_ACTIVATION_TIME" + orderWithdrawTimePtr <- mkOrderWithdrawTimeFun <$> tryLoad dll "TRANS2QUIK_ORDER_WITHDRAW_TIME" + orderExpiryPtr <- mkOrderExpiryFun <$> tryLoad dll "TRANS2QUIK_ORDER_EXPIRY" + orderAccruedIntPtr <- mkOrderAccruedIntFun <$> tryLoad dll "TRANS2QUIK_ORDER_ACCRUED_INT" + orderYieldPtr <- mkOrderYieldFun <$> tryLoad dll "TRANS2QUIK_ORDER_YIELD" + orderUserIdPtr <- mkOrderUserIdFun <$> tryLoad dll "TRANS2QUIK_ORDER_USERID" + orderUidPtr <- mkOrderUidFun <$> tryLoad dll "TRANS2QUIK_ORDER_UID" + orderAccountPtr <- mkOrderAccountFun <$> tryLoad dll "TRANS2QUIK_ORDER_ACCOUNT" + orderBrokerRefPtr <- mkOrderBrokerRefFun <$> tryLoad dll "TRANS2QUIK_ORDER_BROKERREF" + orderClientCodePtr <- mkOrderClientCodeFun <$> tryLoad dll "TRANS2QUIK_ORDER_CLIENT_CODE" + orderFirmIdPtr <- mkOrderFirmIdFun <$> tryLoad dll "TRANS2QUIK_ORDER_FIRMID" + orderVisibleQtyPtr <- mkOrderVisibleQtyFun <$> tryLoad dll "TRANS2QUIK_ORDER_VISIBLE_QTY" + orderPeriodPtr <- mkOrderPeriodFun <$> tryLoad dll "TRANS2QUIK_ORDER_PERIOD" + orderDateTimePtr <- mkOrderDateTimeFun <$> tryLoad dll "TRANS2QUIK_ORDER_DATE_TIME" + + tradeDatePtr <- mkTradeDateFun <$> tryLoad dll "TRANS2QUIK_TRADE_DATE" + tradeSettleDatePtr <- mkTradeSettleDateFun <$> tryLoad dll "TRANS2QUIK_TRADE_SETTLE_DATE" + tradeTimePtr <- mkTradeTimeFun <$> tryLoad dll "TRANS2QUIK_TRADE_TIME" + tradeIsMarginalPtr <- mkTradeIsMarginalFun <$> tryLoad dll "TRANS2QUIK_TRADE_IS_MARGINAL" + tradeCurrencyPtr <- mkTradeCurrencyFun <$> tryLoad dll "TRANS2QUIK_TRADE_CURRENCY" + tradeSettleCurrencyPtr <- mkTradeSettleCurrencyFun <$> tryLoad dll "TRANS2QUIK_TRADE_SETTLE_CURRENCY" + tradeSettleCodePtr <- mkTradeSettleCodeFun <$> tryLoad dll "TRANS2QUIK_TRADE_SETTLE_CODE" + tradeAccruedIntPtr <- mkTradeAccruedIntFun <$> tryLoad dll "TRANS2QUIK_TRADE_ACCRUED_INT" + tradeYieldPtr <- mkTradeYieldFun <$> tryLoad dll "TRANS2QUIK_TRADE_YIELD" + tradeUserIdPtr <- mkTradeUserIdFun <$> tryLoad dll "TRANS2QUIK_TRADE_USERID" + tradeAccountPtr <- mkTradeAccountFun <$> tryLoad dll "TRANS2QUIK_TRADE_ACCOUNT" + tradeBrokerRefPtr <- mkTradeBrokerRefFun <$> tryLoad dll "TRANS2QUIK_TRADE_BROKERREF" + tradeClientCodePtr <- mkTradeClientCodeFun <$> tryLoad dll "TRANS2QUIK_TRADE_CLIENT_CODE" + tradeTsCommissionPtr <- mkTradeTsCommissionFun <$> tryLoad dll "TRANS2QUIK_TRADE_TS_COMMISSION" + tradePeriodPtr <- mkTradePeriodFun <$> tryLoad dll "TRANS2QUIK_TRADE_PERIOD" + tradeDateTimePtr <- mkTradeDateTimeFun <$> tryLoad dll "TRANS2QUIK_TRADE_DATE_TIME" + tradeKindPtr <- mkTradeKindFun <$> tryLoad dll "TRANS2QUIK_TRADE_KIND" return Trans2QuikApi { connect = connectPtr, @@ -497,4 +671,3 @@ loadQuikApi path = do getProcAddress' dll proc = withCAString proc (c_GetProcAddress dll . castPtr) - diff --git a/stack.yaml b/stack.yaml index 53a73b5..e501ad5 100644 --- a/stack.yaml +++ b/stack.yaml @@ -56,8 +56,8 @@ extra-package-dbs: [] # require-stack-version: ">=1.2" # # Override the architecture used by stack, especially useful on Windows -arch: i386 -# arch: x86_64 +# arch: i386 +arch: x86_64 # # Extra directories used by stack for building # extra-include-dirs: [/path/to/dir]