From 9f3b529939b477c0698dd0d73f302a601328a286 Mon Sep 17 00:00:00 2001 From: Denis Tereshkin Date: Tue, 15 Aug 2023 21:13:13 +0700 Subject: [PATCH] gotifysink: fix recursion --- .../Broker/TradeSinks/GotifyTradeSink.hs | 24 +++++++++++-------- 1 file changed, 14 insertions(+), 10 deletions(-) diff --git a/src/ATrade/Broker/TradeSinks/GotifyTradeSink.hs b/src/ATrade/Broker/TradeSinks/GotifyTradeSink.hs index b57ba13..7a8c150 100644 --- a/src/ATrade/Broker/TradeSinks/GotifyTradeSink.hs +++ b/src/ATrade/Broker/TradeSinks/GotifyTradeSink.hs @@ -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 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 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 (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