diff --git a/src/Simplex/FileTransfer/Client/Main.hs b/src/Simplex/FileTransfer/Client/Main.hs index 1eea6ef5a..079392a1b 100644 --- a/src/Simplex/FileTransfer/Client/Main.hs +++ b/src/Simplex/FileTransfer/Client/Main.hs @@ -44,7 +44,7 @@ import Data.List (foldl', sortOn) import Data.List.NonEmpty (NonEmpty (..), nonEmpty) import qualified Data.List.NonEmpty as L import Data.Map.Strict (Map) -import qualified Data.Map as M +import qualified Data.Map.Strict as M import Data.Maybe (fromMaybe, listToMaybe) import qualified Data.Text as T import Data.Word (Word32) diff --git a/src/Simplex/FileTransfer/Description.hs b/src/Simplex/FileTransfer/Description.hs index c702a177f..8c27d80e7 100644 --- a/src/Simplex/FileTransfer/Description.hs +++ b/src/Simplex/FileTransfer/Description.hs @@ -53,7 +53,7 @@ import Data.List (foldl', sortOn) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as L import Data.Map.Strict (Map) -import qualified Data.Map as M +import qualified Data.Map.Strict as M import Data.Maybe (fromMaybe) import Data.String import Data.Text (Text) diff --git a/src/Simplex/FileTransfer/Server.hs b/src/Simplex/FileTransfer/Server.hs index 819be9a81..be4c7d85f 100644 --- a/src/Simplex/FileTransfer/Server.hs +++ b/src/Simplex/FileTransfer/Server.hs @@ -475,7 +475,7 @@ processXFTPRequest HTTP2Body {bodyPart} = \case pure FROk Left e -> do us <- asks $ usedStorage . store - atomically . modifyTVar' us $ subtract (fromIntegral size) + atomically $ modifyTVar' us $ subtract (fromIntegral size) liftIO $ whenM (doesFileExist fPath) (removeFile fPath) `catch` logFileError pure $ FRErr e receiveChunk spec = do @@ -571,7 +571,7 @@ withFileLog action = liftIO . mapM_ action =<< asks storeLog incFileStat :: (FileServerStats -> TVar Int) -> M () incFileStat statSel = do stats <- asks serverStats - atomically $ modifyTVar (statSel stats) (+ 1) + atomically $ modifyTVar' (statSel stats) (+ 1) saveServerStats :: M () saveServerStats = diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs index 131561f4d..8e17d9af6 100644 --- a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs +++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs @@ -29,7 +29,7 @@ import Control.Monad (forM_, when) import qualified Data.Aeson.TH as J import Data.List (intercalate, sortOn) import Data.List.NonEmpty (NonEmpty) -import qualified Data.Map as M +import qualified Data.Map.Strict as M import Data.Maybe (isNothing, mapMaybe) import Data.Text (Text) import Data.Text.Encoding (decodeLatin1) diff --git a/src/Simplex/Messaging/Agent/TRcvQueues.hs b/src/Simplex/Messaging/Agent/TRcvQueues.hs index 3b02f64ae..38a60d6e0 100644 --- a/src/Simplex/Messaging/Agent/TRcvQueues.hs +++ b/src/Simplex/Messaging/Agent/TRcvQueues.hs @@ -63,7 +63,7 @@ addQueue rq (TRcvQueues qs cs) = do addQ = Just . maybe (k :| []) (k <|) k = qKey rq --- Save time by aggregating modifyTVar +-- Save time by aggregating modifyTVar' batchAddQueues :: (Foldable t, Queue q) => TRcvQueues q -> t q -> STM () batchAddQueues (TRcvQueues qs cs) rqs = do modifyTVar' qs $ \now -> foldl' (\rqs' rq -> M.insert (qKey rq) rq rqs') now rqs diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs index 87fe3e9cb..b583f578c 100644 --- a/src/Simplex/Messaging/Server.hs +++ b/src/Simplex/Messaging/Server.hs @@ -768,7 +768,7 @@ send th c@Client {sndQ, msgQ, sessionId} stats = do ts@((_, _, END) :| _) -> do -- END events are not combined with others let len = L.length ts atomically $ modifyTVar' (qSubEndSent stats) (+ len) - atomically $ modifyTVar' (qSubEndSentB stats) (+ len `div` 255) -- up to 255 ENDs in the batch + atomically $ modifyTVar' (qSubEndSentB stats) (+ (len `div` 255 + 1)) -- up to 255 ENDs in the batch _ -> pure () sendMsg :: Transport c => MVar (THandleSMP c 'TServer) -> Client -> IO () @@ -1315,7 +1315,7 @@ client thParams' clnt@Client {subscriptions, ntfSubscriptions, rcvQ, sndQ, sessi void $ setDelivered s msg forkDeliver (rc@Client {sndQ = q}, s@Sub {delivered}, st) = do t <- mkWeakThreadId =<< forkIO deliverThread - atomically . modifyTVar' st $ \case + atomically $ modifyTVar' st $ \case -- this case is needed because deliverThread can exit before it SubPending -> SubThread t st' -> st'