diff --git a/src/Broker/QuikBroker/HsQuik.hs b/src/Broker/QuikBroker/HsQuik.hs new file mode 100644 index 0000000..5bbb8df --- /dev/null +++ b/src/Broker/QuikBroker/HsQuik.hs @@ -0,0 +1,5 @@ + +module Broker.QuikBroker.HsQuik ( +) where + +import Broker.QuikBroker.Trans2QuikApi diff --git a/src/Broker/QuikBroker/Trans2QuikApi.hs b/src/Broker/QuikBroker/Trans2QuikApi.hs index 3ddb227..806d5d7 100644 --- a/src/Broker/QuikBroker/Trans2QuikApi.hs +++ b/src/Broker/QuikBroker/Trans2QuikApi.hs @@ -14,8 +14,26 @@ import Control.Error.Util import Control.Monad.IO.Class import System.Win32.DLL import System.Win32.Types +import Control.Concurrent +import Data.IORef 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 + type ConnectF = LPCSTR -> Ptr LONG -> LPSTR -> DWORD -> IO LONG foreign import ccall "dynamic" mkConnectFun :: FunPtr ConnectF -> ConnectF @@ -44,7 +62,7 @@ type ConnectionStatusCallback = LONG -> LONG -> LPSTR -> IO () foreign import ccall "wrapper" mkConnectionStatusCallback :: ConnectionStatusCallback -> IO (FunPtr ConnectionStatusCallback) -type SetConnectionStatusCallbackF = FunPtr ConnectionStatusCallback -> Ptr LONG -> LPSTR -> DWORD -> LONG +type SetConnectionStatusCallbackF = FunPtr ConnectionStatusCallback -> Ptr LONG -> LPSTR -> DWORD -> IO LONG foreign import ccall "dynamic" mkSetConnectionStatusCallbackFun :: FunPtr SetConnectionStatusCallbackF -> SetConnectionStatusCallbackF @@ -52,7 +70,7 @@ type TransactionsReplyCallback = LONG -> LONG -> LONG -> DWORD -> CDouble -> LPS foreign import ccall "wrapper" mkTransactionsReplyCallback :: TransactionsReplyCallback -> IO (FunPtr TransactionsReplyCallback) -type SetTransactionsReplyCallbackF = FunPtr TransactionsReplyCallback -> Ptr LONG -> LPSTR -> DWORD -> LONG +type SetTransactionsReplyCallbackF = FunPtr TransactionsReplyCallback -> Ptr LONG -> LPSTR -> DWORD -> IO LONG foreign import ccall "dynamic" mkSetTransactionsReplyCallbackFun :: FunPtr SetTransactionsReplyCallbackF -> SetTransactionsReplyCallbackF @@ -264,11 +282,6 @@ data Trans2QuikApi = Trans2QuikApi { unsubscribeOrders :: UnsubscribeOrdersF, unsubscribeTrades :: UnsubscribeTradesF, - connectionStatusCallback :: Maybe (FunPtr ConnectionStatusCallback), - transactionReplyCallback :: Maybe (FunPtr TransactionsReplyCallback), - orderStatusCallback :: Maybe (FunPtr OrderStatusCallback), - tradeStatusCallback :: Maybe (FunPtr TradeStatusCallback), - orderQty :: OrderQtyF, orderDate :: OrderDateF, orderTime :: OrderTimeF, @@ -308,6 +321,58 @@ data Trans2QuikApi = Trans2QuikApi { dllHandle :: HMODULE } +data Quik = Quik { + quikApi :: Trans2QuikApi, + + connectionCallback :: FunPtr ConnectionStatusCallback, + transactionCallback :: FunPtr TransactionsReplyCallback, + orderCallback :: FunPtr OrderStatusCallback, + tradeCallback :: FunPtr TradeStatusCallback, + + connected :: Bool, + watchdogTid :: ThreadId +} + +mkQuik :: FilePath -> FilePath -> ConnectionStatusCallback -> TransactionsReplyCallback -> OrderStatusCallback -> TradeStatusCallback -> ExceptT T.Text IO (IORef Quik) +mkQuik dllpath quikpath conncb transcb orcb tradecb = do + api <- loadQuikApi dllpath + + conncb' <- liftIO (mkConnectionStatusCallback conncb) + transcb' <- liftIO (mkTransactionsReplyCallback transcb) + orcb' <- liftIO (mkOrderStatusCallback orcb) + tradecb' <- liftIO (mkTradeStatusCallback tradecb) + + myTid <- liftIO myThreadId + state <- liftIO $ newIORef Quik { quikApi = api, + connectionCallback = conncb', + transactionCallback = transcb', + orderCallback = orcb', + tradeCallback = tradecb', + connected = False, + watchdogTid = myTid } + + tid <- liftIO (forkIO $ watchdog quikpath state) + liftIO $ atomicModifyIORef' (\s -> s { watchdogTid = tid }) + return state + +watchdog :: FilePath -> IORef Quik -> IO () +watchdog quikpath state = do + api <- quikApi <$> readIORef state + conncb <- connectionCallback <$> readIORef state + + alloca (\errorCode -> + allocaBytes 1024 (\errorMsg -> do + 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) + threadDelay 5000000)) + loadQuikApi :: FilePath -> ExceptT T.Text IO Trans2QuikApi loadQuikApi path = do dll <- castPtr <$> liftIO (loadLibrary path) @@ -432,3 +497,4 @@ loadQuikApi path = do getProcAddress' dll proc = withCAString proc (c_GetProcAddress dll . castPtr) +