diff --git a/cabal.project b/cabal.project index c465ffa26..b40b009b3 100644 --- a/cabal.project +++ b/cabal.project @@ -9,7 +9,7 @@ constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: 17a1a911d885eae8b939fd6deaa797f3dc72289c + tag: 980e5c4d1ec15f44290542fd2a5d1c08456f00d1 source-repository-package type: git diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index 7d90d9e01..09ac41e49 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."17a1a911d885eae8b939fd6deaa797f3dc72289c" = "03530jwrdn3skmyzhvaml01j41lynl0m2ym0wvppj19sckg7a6mh"; + "https://github.com/simplex-chat/simplexmq.git"."980e5c4d1ec15f44290542fd2a5d1c08456f00d1" = "1lqciyy215dvmbhykyp80bwipqmxybv39p6jff6vjgd5r34958nh"; "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38"; "https://github.com/kazu-yamamoto/http2.git"."b5a1b7200cf5bc7044af34ba325284271f6dff25" = "0dqb50j57an64nf4qcf5vcz4xkd1vzvghvf8bk529c1k30r9nfzb"; "https://github.com/simplex-chat/direct-sqlcipher.git"."34309410eb2069b029b8fc1872deb1e0db123294" = "0kwkmhyfsn2lixdlgl15smgr1h5gjk7fky6abzh8rng2h5ymnffd"; diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index dd7e90425..79a39780a 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -25,7 +25,7 @@ import Crypto.Random (drgNew) import qualified Data.Aeson as J import Data.Attoparsec.ByteString.Char8 (Parser) import qualified Data.Attoparsec.ByteString.Char8 as A -import Data.Bifunctor (bimap, first, second) +import Data.Bifunctor (bimap, first) import qualified Data.ByteString.Base64 as B64 import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B @@ -41,7 +41,6 @@ import qualified Data.List.NonEmpty as L import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing, listToMaybe, mapMaybe, maybeToList) -import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) @@ -1757,17 +1756,17 @@ processChatCommand = \case ResetAgentStats -> withAgent resetAgentStats >> ok_ GetAgentSubs -> summary <$> withAgent getAgentSubscriptions where - summary SubscriptionsInfo {activeSubscriptions, pendingSubscriptions} = - CRAgentSubs {activeSubs, distinctActiveSubs, pendingSubs, distinctPendingSubs} + summary SubscriptionsInfo {activeSubscriptions, pendingSubscriptions, removedSubscriptions} = + CRAgentSubs + { activeSubs = foldl' countSubs M.empty activeSubscriptions, + pendingSubs = foldl' countSubs M.empty pendingSubscriptions, + removedSubs = foldl' accSubErrors M.empty removedSubscriptions + } where - (activeSubs, distinctActiveSubs) = foldSubs activeSubscriptions - (pendingSubs, distinctPendingSubs) = foldSubs pendingSubscriptions - foldSubs :: [SubInfo] -> (Map Text Int, Map Text Int) - foldSubs = second (M.map S.size) . foldl' acc (M.empty, M.empty) - acc (m, m') SubInfo {server, rcvId} = - ( M.alter (Just . maybe 1 (+ 1)) server m, - M.alter (Just . maybe (S.singleton rcvId) (S.insert rcvId)) server m' - ) + countSubs m SubInfo {server} = M.alter (Just . maybe 1 (+ 1)) server m + accSubErrors m = \case + SubInfo {server, subError = Just e} -> M.alter (Just . maybe [e] (e :)) server m + _ -> m GetAgentSubsDetails -> CRAgentSubsDetails <$> withAgent getAgentSubscriptions where withChatLock name action = asks chatLock >>= \l -> withLock l name action diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index f766edf0c..3a286cf98 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -573,7 +573,7 @@ data ChatResponse | CRSlowSQLQueries {chatQueries :: [SlowSQLQuery], agentQueries :: [SlowSQLQuery]} | CRDebugLocks {chatLockName :: Maybe String, agentLocks :: AgentLocks} | CRAgentStats {agentStats :: [[String]]} - | CRAgentSubs {activeSubs :: Map Text Int, distinctActiveSubs :: Map Text Int, pendingSubs :: Map Text Int, distinctPendingSubs :: Map Text Int} + | CRAgentSubs {activeSubs :: Map Text Int, pendingSubs :: Map Text Int, removedSubs :: Map Text [String]} | CRAgentSubsDetails {agentSubs :: SubscriptionsInfo} | CRConnectionDisabled {connectionEntity :: ConnectionEntity} | CRAgentRcvQueueDeleted {agentConnId :: AgentConnId, server :: SMPServer, agentQueueId :: AgentQueueId, agentError_ :: Maybe AgentErrorType} diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 172155747..5a92c8ab4 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -20,6 +20,7 @@ import Data.Int (Int64) import Data.List (groupBy, intercalate, intersperse, partition, sortOn) import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as L +import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe) import Data.Text (Text) @@ -262,17 +263,18 @@ responseToView user_ ChatConfig {logLevel, showReactions, showReceipts, testView plain $ "agent locks: " <> LB.unpack (J.encode agentLocks) ] CRAgentStats stats -> map (plain . intercalate ",") stats - CRAgentSubs {activeSubs, distinctActiveSubs, pendingSubs, distinctPendingSubs} -> - [plain $ "Subscriptions: active = " <> show (sum activeSubs) <> ", distinct active = " <> show (sum distinctActiveSubs) <> ", pending = " <> show (sum pendingSubs) <> ", distinct pending = " <> show (sum distinctPendingSubs)] + CRAgentSubs {activeSubs, pendingSubs, removedSubs} -> + [plain $ "Subscriptions: active = " <> show (sum activeSubs) <> ", pending = " <> show (sum pendingSubs) <> ", removed = " <> show (sum $ M.map length removedSubs)] <> ("active subscriptions:" : listSubs activeSubs) - <> ("distinct active subscriptions:" : listSubs distinctActiveSubs) <> ("pending subscriptions:" : listSubs pendingSubs) - <> ("distinct pending subscriptions:" : listSubs distinctPendingSubs) + <> ("removed subscriptions:" : listSubs removedSubs) where - listSubs = map (\(srv, count) -> plain $ srv <> ": " <> tshow count) . M.assocs - CRAgentSubsDetails SubscriptionsInfo {activeSubscriptions, pendingSubscriptions} -> + listSubs :: Show a => Map Text a -> [StyledString] + listSubs = map (\(srv, info) -> plain $ srv <> ": " <> tshow info) . M.assocs + CRAgentSubsDetails SubscriptionsInfo {activeSubscriptions, pendingSubscriptions, removedSubscriptions} -> ("active subscriptions:" : map sShow activeSubscriptions) <> ("pending subscriptions: " : map sShow pendingSubscriptions) + <> ("removed subscriptions: " : map sShow removedSubscriptions) CRConnectionDisabled entity -> viewConnectionEntityDisabled entity CRAgentRcvQueueDeleted acId srv aqId err_ -> [ ("completed deleting rcv queue, agent connection id: " <> sShow acId) diff --git a/stack.yaml b/stack.yaml index c3f99b6d9..c949cbb16 100644 --- a/stack.yaml +++ b/stack.yaml @@ -49,7 +49,7 @@ extra-deps: # - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561 # - ../simplexmq - github: simplex-chat/simplexmq - commit: 17a1a911d885eae8b939fd6deaa797f3dc72289c + commit: 980e5c4d1ec15f44290542fd2a5d1c08456f00d1 - github: kazu-yamamoto/http2 commit: b5a1b7200cf5bc7044af34ba325284271f6dff25 # - ../direct-sqlcipher