Browse Source

Tradesinks fixes

master
Denis Tereshkin 8 years ago
parent
commit
bb7a6d6b11
  1. 2
      src/ATrade/Broker/Server.hs
  2. 6
      src/ATrade/Broker/TradeSinks/TelegramTradeSink.hs
  3. 11
      src/ATrade/Broker/TradeSinks/ZMQTradeSink.hs

2
src/ATrade/Broker/Server.hs

@ -117,7 +117,7 @@ tradeSinkHandler c state tradeSinks = unless (null tradeSinks) $
maybeTrade <- tryReadChan chan maybeTrade <- tryReadChan chan
case maybeTrade of case maybeTrade of
Just trade -> mapM_ (\x -> x trade) tradeSinks Just trade -> mapM_ (\x -> x trade) tradeSinks
Nothing -> return () Nothing -> threadDelay 1000000
where where
wasKilled = isJust <$> (killMvar <$> readIORef state >>= tryReadMVar) wasKilled = isJust <$> (killMvar <$> readIORef state >>= tryReadMVar)

6
src/ATrade/Broker/TradeSinks/TelegramTradeSink.hs

@ -41,14 +41,16 @@ sinkThread apitoken chatId killMv chan = do
man <- newManager $ mkManagerSettings tlsSettings Nothing man <- newManager $ mkManagerSettings tlsSettings Nothing
whileM_ (not <$> wasKilled) $ do whileM_ (not <$> wasKilled) $ do
maybeTrade <- BC.tryReadChan chan maybeTrade <- BC.tryReadChan chan
whenJust maybeTrade (\trade -> sendMessage man apitoken chatId $ format "Trade: {} {} of {} at {} for {} ({}/{})" case maybeTrade of
Just trade -> sendMessage man apitoken chatId $ format "Trade: {} {} of {} at {} for {} ({}/{})"
(show (tradeOperation trade), (show (tradeOperation trade),
show (tradeQuantity trade), show (tradeQuantity trade),
tradeSecurity trade, tradeSecurity trade,
show (tradePrice trade), show (tradePrice trade),
tradeAccount trade, tradeAccount trade,
(strategyId . tradeSignalId) trade, (strategyId . tradeSignalId) trade,
(signalName . tradeSignalId) trade)) (signalName . tradeSignalId) trade)
Nothing -> threadDelay 1000000
where where
tlsSettings = TLSSettingsSimple { settingDisableCertificateValidation = True, settingDisableSession = False, settingUseServerName = False } tlsSettings = TLSSettingsSimple { settingDisableCertificateValidation = True, settingDisableSession = False, settingUseServerName = False }
wasKilled = isJust <$> tryReadMVar killMv wasKilled = isJust <$> tryReadMVar killMv

11
src/ATrade/Broker/TradeSinks/ZMQTradeSink.hs

@ -30,7 +30,7 @@ withZMQTradeSink ctx tradeSinkEp f = do
where where
sink = BC.writeChan sink = BC.writeChan
sinkThread ctx tradeSinkEp killMv chan = whileM_ (not <$> wasKilled) $ do sinkThread ctx tradeSinkEp killMv chan = whileM_ (not <$> wasKilled) $
handle (\e -> do handle (\e -> do
warningM "Broker.Server" $ "Trade sink: exception: " ++ show (e :: SomeException) ++ "; isZMQ: " ++ show (isZMQError e) warningM "Broker.Server" $ "Trade sink: exception: " ++ show (e :: SomeException) ++ "; isZMQ: " ++ show (isZMQError e)
when (isZMQError e) $ do when (isZMQError e) $ do
@ -39,20 +39,23 @@ sinkThread ctx tradeSinkEp killMv chan = whileM_ (not <$> wasKilled) $ do
where where
sinkThread' = withSocket ctx Dealer (\sock -> do sinkThread' = withSocket ctx Dealer (\sock -> do
connect sock $ T.unpack tradeSinkEp connect sock $ T.unpack tradeSinkEp
whenM (not <$> wasKilled) $ do whenM (not <$> wasKilled) $ sinkThread'' sock)
sinkThread'' sock = do
maybeTrade <- BC.tryReadChan chan maybeTrade <- BC.tryReadChan chan
case maybeTrade of case maybeTrade of
Just trade -> do Just trade -> do
sendMulti sock $ B.empty :| [encodeTrade trade] sendMulti sock $ B.empty :| [encodeTrade trade]
void $ receiveMulti sock void $ receiveMulti sock
Nothing -> do Nothing -> do
threadDelay 1000000
sendMulti sock $ B.empty :| [BL.toStrict $ encode TradeSinkHeartBeat] sendMulti sock $ B.empty :| [BL.toStrict $ encode TradeSinkHeartBeat]
events <- poll 1000 [Sock sock [In] Nothing] events <- poll 5000 [Sock sock [In] Nothing]
if L.null . L.head $ events if L.null . L.head $ events
then warningM "Broker.Server" "Trade sink timeout" then warningM "Broker.Server" "Trade sink timeout"
else do else do
void . receive $ sock -- anything will do void . receive $ sock -- anything will do
sinkThread') sinkThread'' sock
isZMQError e = "ZMQError" `L.isPrefixOf` show e isZMQError e = "ZMQError" `L.isPrefixOf` show e

Loading…
Cancel
Save