gotifysink: fix recursion

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,15 +57,8 @@ sinkThread server token killMv chan logger = whileM_ (not <$> wasKilled) $ do
     sinkThread' manager = do
       maybeTrade <- BC.tryReadChan chan
       case maybeTrade of
-        Just trade -> do
+        Just trade -> sendToSink manager (encodeTrade trade)
-          request <- parseRequest $ server <> "/message?token=" <> token
+        Nothing    -> threadDelay 1000000
-          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
 
     wasKilled = isJust <$> tryReadMVar killMv
@@ -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