Browse Source

gotifysink: fix recursion

master
Denis Tereshkin 2 years ago
parent
commit
9f3b529939
  1. 24
      src/ATrade/Broker/TradeSinks/GotifyTradeSink.hs

24
src/ATrade/Broker/TradeSinks/GotifyTradeSink.hs

@ -34,6 +34,7 @@ import Language.Haskell.Printf @@ -34,6 +34,7 @@ import Language.Haskell.Printf
import Network.HTTP.Client (defaultManagerSettings,
httpLbs, newManager,
parseRequest,
responseStatus,
withManager)
import Network.HTTP.Client.MultipartFormData (formDataBody, partBS)
@ -48,6 +49,7 @@ sinkThread server token killMv chan logger = whileM_ (not <$> wasKilled) $ do @@ -48,6 +49,7 @@ sinkThread server token killMv chan logger = whileM_ (not <$> wasKilled) $ do
log Info "GotifyTradeSink thread started"
manager <- newManager defaultManagerSettings
log Debug "Connected"
sendToSink manager "Gotify tradesink started"
sinkThread' manager
log Info "Disconnected"
where
@ -55,16 +57,9 @@ sinkThread server token killMv chan logger = whileM_ (not <$> wasKilled) $ do @@ -55,16 +57,9 @@ sinkThread server token killMv chan logger = whileM_ (not <$> wasKilled) $ do
sinkThread' manager = do
maybeTrade <- BC.tryReadChan chan
case maybeTrade of
Just trade -> do
request <- parseRequest $ server <> "/message?token=" <> token
requestWithData <-
formDataBody [ partBS "title" "Trade"
, partBS "message" (encodeTrade trade)
, partBS "priority" "5"] request
void $ httpLbs requestWithData manager
Nothing -> do
threadDelay 1000000
whenM (isEmptyMVar killMv) $ sinkThread' manager
Just trade -> sendToSink manager (encodeTrade trade)
Nothing -> threadDelay 1000000
whenM (isEmptyMVar killMv) $ sinkThread' manager
wasKilled = isJust <$> tryReadMVar killMv
encodeTrade :: Trade -> B.ByteString
@ -77,5 +72,14 @@ sinkThread server token killMv chan logger = whileM_ (not <$> wasKilled) $ do @@ -77,5 +72,14 @@ sinkThread server token killMv chan logger = whileM_ (not <$> wasKilled) $ do
(strategyId . tradeSignalId $ trade)
(signalName . tradeSignalId $ trade)
sendToSink manager bs = do
request <- parseRequest $ server <> "/message?token=" <> token
requestWithData <-
formDataBody [ partBS "title" "Message"
, partBS "message" bs
, partBS "priority" "5"] request
response <- httpLbs requestWithData manager
log Debug $ "Response status: " <> (T.pack . show . responseStatus) response
stopSinkThread killMv threadId = putMVar killMv () >> threadDelay 10000000

Loading…
Cancel
Save