Browse Source

Quik: fix connection issues

master
Denis Tereshkin 9 years ago
parent
commit
aee3681b3c
  1. 14
      src/Broker/QuikBroker/Trans2QuikApi.hs
  2. 3
      stack.yaml

14
src/Broker/QuikBroker/Trans2QuikApi.hs

@ -375,6 +375,7 @@ data Quik = Quik {
hlTradeCallback :: Maybe HlTradeCallback, hlTradeCallback :: Maybe HlTradeCallback,
connectedToServer :: Bool, connectedToServer :: Bool,
connectedToDll :: Bool,
watchdogTid :: ThreadId, watchdogTid :: ThreadId,
handledTrades :: S.Set CLLong, handledTrades :: S.Set CLLong,
@ -412,6 +413,7 @@ mkQuik dllpath quikpath = do
myTid <- liftIO myThreadId myTid <- liftIO myThreadId
state <- liftIO $ newIORef Quik { quikApi = api, state <- liftIO $ newIORef Quik { quikApi = api,
connectedToServer = False, connectedToServer = False,
connectedToDll = False,
watchdogTid = myTid, watchdogTid = myTid,
hlTransactionCallback = Nothing, hlTransactionCallback = Nothing,
hlOrderCallback = Nothing, hlOrderCallback = Nothing,
@ -429,7 +431,7 @@ mkQuik dllpath quikpath = do
orderCallback = orcb', orderCallback = orcb',
tradeCallback = tradecb' }, ()))) tradeCallback = tradecb' }, ())))
tid <- liftIO (forkOS $ watchdog quikpath state) tid <- liftIO (forkIO $ watchdog quikpath state)
liftIO $ atomicModifyIORef' state (\s -> (s { watchdogTid = tid }, ())) liftIO $ atomicModifyIORef' state (\s -> (s { watchdogTid = tid }, ()))
liftIO $ debugM "Quik" "mkQuik done" liftIO $ debugM "Quik" "mkQuik done"
return state return state
@ -438,6 +440,8 @@ defaultConnectionCb :: IORef Quik -> LONG -> LONG -> LPSTR -> IO ()
defaultConnectionCb state event errorCode infoMessage defaultConnectionCb state event errorCode infoMessage
| event == ecQuikConnected = infoM "Quik" "Quik connected" >> atomicModifyIORef' state (\s -> (s { connectedToServer = True }, ()) ) | event == ecQuikConnected = infoM "Quik" "Quik connected" >> atomicModifyIORef' state (\s -> (s { connectedToServer = True }, ()) )
| event == ecQuikDisconnected = infoM "Quik" "Quik disconnected" >> atomicModifyIORef' state (\s -> (s { connectedToServer = False }, ()) ) | event == ecQuikDisconnected = infoM "Quik" "Quik disconnected" >> atomicModifyIORef' state (\s -> (s { connectedToServer = False }, ()) )
| event == ecDllConnected = infoM "Quik" "DLL connected" >> atomicModifyIORef' state (\s -> (s { connectedToDll = True }, ()) )
| event == ecDllDisconnected = infoM "Quik" "DLL disconnected" >> atomicModifyIORef' state (\s -> (s { connectedToDll = True }, ()) )
| otherwise = debugM "Quik" $ "Connection event: " ++ show event | otherwise = debugM "Quik" $ "Connection event: " ++ show event
defaultTransactionReplyCb :: IORef Quik -> LONG -> LONG -> LONG -> DWORD -> CLLong -> LPSTR -> CIntPtr -> IO () defaultTransactionReplyCb :: IORef Quik -> LONG -> LONG -> LONG -> DWORD -> CLLong -> LPSTR -> CIntPtr -> IO ()
@ -528,11 +532,11 @@ watchdog quikpath state = do
if err /= ecSuccess if err /= ecSuccess
then warningM "Quik.Watchdog" $ "Error: " ++ show err then warningM "Quik.Watchdog" $ "Error: " ++ show err
else forever $ do else forever $ do
conn <- isDllConnected api errorCode errorMsg 1024 conn <- connectedToDll <$> readIORef state
when (conn == ecDllNotConnected) $ unless conn $
withCString quikpath (\path -> do withCString quikpath (\path -> do
err <- connect api path errorCode errorMsg 1024 err <- connect api path errorCode errorMsg 1024
if err /= ecSuccess if err /= ecSuccess && err /= ecAlreadyConnectedToQuik
then warningM "Quik.Watchdog" $ "Unable to connect: " ++ show err then warningM "Quik.Watchdog" $ "Unable to connect: " ++ show err
else withCString "" (\emptyStr -> do else withCString "" (\emptyStr -> do
res <- (runExceptT $ do res <- (runExceptT $ do
@ -544,7 +548,7 @@ watchdog quikpath state = do
case res of case res of
Left err -> warningM "Quik.Watchdog" $ "Unable to set callbacks: " ++ show err Left err -> warningM "Quik.Watchdog" $ "Unable to set callbacks: " ++ show err
Right _ -> debugM "Quik.Watchdog" "Callbacks are set")) Right _ -> debugM "Quik.Watchdog" "Callbacks are set"))
threadDelay 1000)) threadDelay 10000000))
throwIfErr :: IO LONG -> ExceptT T.Text IO () throwIfErr :: IO LONG -> ExceptT T.Text IO ()
throwIfErr action = do throwIfErr action = do

3
stack.yaml

@ -38,9 +38,10 @@ resolver: lts-7.7
packages: packages:
- '.' - '.'
- '../libatrade' - '../libatrade'
- '../zeromq-haskell'
# Dependency packages to be pulled from upstream that are not in the resolver # Dependency packages to be pulled from upstream that are not in the resolver
# (e.g., acme-missiles-0.3) # (e.g., acme-missiles-0.3)
extra-deps: [ "datetime-0.3.1", "cond-0.4.1.1" ] extra-deps: [ "datetime-0.3.1", "cond-0.4.1.1"]
# Override default flag values for local packages and extra-deps # Override default flag values for local packages and extra-deps
flags: {} flags: {}

Loading…
Cancel
Save