diff --git a/src/TXMLConnector.hs b/src/TXMLConnector.hs index bb3dd1d..199e81b 100644 --- a/src/TXMLConnector.hs +++ b/src/TXMLConnector.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -196,6 +197,7 @@ data BrokerState = , bsPendingOrders :: TVar (D.Deque Order) } + data Env = Env { @@ -382,7 +384,7 @@ workThread = do resp <- asks responseVar >>= liftIO . atomically . tryReadTMVar log Debug "TXMLConnector.WorkThread" $ "Incoming candles: " <> (T.pack . show . length) (cCandles respCandle) case resp of - Just tmvar -> if cStatus respCandle == StatusPending + Just !tmvar -> if cStatus respCandle == StatusPending then do cur <- asks currentCandles liftIO $ atomically . modifyTVar' cur $ (\c -> cCandles respCandle <> c) @@ -596,12 +598,41 @@ workThread = do log Debug "TXMLConnector.WorkThread" $ "Incoming client data: " <> (T.pack . show) (cClientId clientData) <> "#" <> (T.pack . show) (cUnion clientData) _ -> pure () + handleUnconnected :: App () handleUnconnected = do cfg <- asks config log Debug "TXMLConnector.WorkThread" "Sending connect command" - v <- liftIO . sendCommand . - toXml $ CommandConnect + v <- liftIO . sendCommand . toXml $ cmdConnect cfg + case v of + Left _ -> do + log Warning "TXMLConnector.WorkThread" "Unable to connect" + liftIO $ do + void $ sendCommand $ toXml CommandDisconnect + threadDelay reconnectionDelay + queue <- asks transaqQueue + void $ liftIO $ atomically $ flushTBQueue queue + Right _ -> do + log Info "TXMLConnector.WorkThread" "Connected" + conn <- asks serverConnected + liftIO . atomically $ writeTVar conn StageGetInfo + + makeSubscriptions config = liftIO . sendCommand . toXml $ cmdSubscription config + + subscriptionToSecurityId (SubscriptionConfig brd code) = SecurityId brd code + insertToTickMap tickMap tick = insertTick tickMap tick + + reconnectionDelay = 1000 * 1000 * 10 + + cmdSubscription config = + CommandSubscribe + { + alltrades = fmap subscriptionToSecurityId (allTradesSubscriptions config), + quotations = fmap subscriptionToSecurityId (quotationsSubscriptions config), + quotes = fmap subscriptionToSecurityId (quotesSubscriptions config) + } + + cmdConnect cfg = CommandConnect { login = transaqLogin cfg, password = transaqPassword cfg, @@ -619,27 +650,6 @@ workThread = do pushULimits = Nothing, pushPosEquity = Nothing } - case v of - Left _ -> do - log Warning "TXMLConnector.WorkThread" "Unable to connect" - void $ liftIO $ sendCommand $ toXml $ CommandDisconnect - liftIO $ threadDelay (1000 * 1000 * 10) - queue <- asks transaqQueue - void $ liftIO $ atomically $ flushTBQueue queue - Right _ -> do - log Info "TXMLConnector.WorkThread" "Connected" - conn <- asks serverConnected - liftIO . atomically $ writeTVar conn StageGetInfo - makeSubscriptions config = - liftIO . sendCommand . toXml $ - CommandSubscribe - { - alltrades = fmap subscriptionToSecurityId (allTradesSubscriptions config), - quotations = fmap subscriptionToSecurityId (quotationsSubscriptions config), - quotes = fmap subscriptionToSecurityId (quotesSubscriptions config) - } - subscriptionToSecurityId (SubscriptionConfig brd code) = SecurityId brd code - insertToTickMap tickMap tick = insertTick tickMap tick allTradeToTick :: AllTradesTrade -> Tick allTradeToTick att =