diff --git a/src/Simplex/Messaging/Notifications/Server.hs b/src/Simplex/Messaging/Notifications/Server.hs index 3e8c14607..1de707e58 100644 --- a/src/Simplex/Messaging/Notifications/Server.hs +++ b/src/Simplex/Messaging/Notifications/Server.hs @@ -109,9 +109,9 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg} started = do liftIO $ threadDelay' $ 1000000 * (initialDelay + if initialDelay < 0 then 86400 else 0) NtfServerStats {fromTime, tknCreated, tknVerified, tknDeleted, subCreated, subDeleted, ntfReceived, ntfDelivered, activeTokens, activeSubs} <- asks serverStats let interval = 1000000 * logInterval - withFile statsFilePath AppendMode $ \h -> liftIO $ do - hSetBuffering h LineBuffering - forever $ do + forever $ do + withFile statsFilePath AppendMode $ \h -> liftIO $ do + hSetBuffering h LineBuffering ts <- getCurrentTime fromTime' <- atomically $ swapTVar fromTime ts tknCreated' <- atomically $ swapTVar tknCreated 0 @@ -141,7 +141,7 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg} started = do weekCount sub, monthCount sub ] - threadDelay' interval + liftIO $ threadDelay' interval resubscribe :: NtfSubscriber -> Map NtfSubscriptionId NtfSubData -> M () resubscribe NtfSubscriber {newSubQ} subs = do diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs index dea9b27c8..1bf7de2eb 100644 --- a/src/Simplex/Messaging/Server.hs +++ b/src/Simplex/Messaging/Server.hs @@ -203,9 +203,9 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do liftIO $ threadDelay' $ 1000000 * (initialDelay + if initialDelay < 0 then 86400 else 0) ServerStats {fromTime, qCreated, qSecured, qDeleted, msgSent, msgRecv, msgExpired, activeQueues, msgSentNtf, msgRecvNtf, activeQueuesNtf, qCount, msgCount} <- asks serverStats let interval = 1000000 * logInterval - withFile statsFilePath AppendMode $ \h -> liftIO $ do - hSetBuffering h LineBuffering - forever $ do + forever $ do + withFile statsFilePath AppendMode $ \h -> liftIO $ do + hSetBuffering h LineBuffering ts <- getCurrentTime fromTime' <- atomically $ swapTVar fromTime ts qCreated' <- atomically $ swapTVar qCreated 0 @@ -241,7 +241,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do show msgCount', show msgExpired' ] - threadDelay' interval + liftIO $ threadDelay' interval runClient :: Transport c => TProxy c -> c -> M () runClient tp h = do