blade/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2024-12-17 17:20:21 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

core: add debug info for subscriptions (#3014)

Browse Source
This commit is contained in:
Evgeny Poberezkin
2023-09-04 23:19:24 +01:00
committed by GitHub
parent c7f1af8742
commit 0ec3e0c18d
6 changed files with 23 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat.hs
+11 -12
View File
@@ -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
src/Simplex/Chat/Controller.hs
+1 -1
View File
@@ -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}
src/Simplex/Chat/View.hs
+8 -6
View File
@@ -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)