dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-05-13 21:33:41 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'master' into master-ios

Browse Source
This commit is contained in:
Evgeny Poberezkin
2023-08-25 14:11:13 +01:00
parent 62a4fd2c7c 3a93954c50
commit f8b757ddf9
6 changed files with 42 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files
cabal.project
+1 -1
View File
@@ -9,7 +9,7 @@ constraints: zip +disable-bzip2 +disable-zstd
source-repository-package
type: git
location: https://github.com/simplex-chat/simplexmq.git
tag: 44abb90c63dba63ab5f6d379131e5a7e0f625e98
tag: 066d91b0f594e1c9a9c584900cc133e9cec01e55
source-repository-package
type: git
scripts/nix/sha256map.nix
+1 -1
View File
@@ -1,5 +1,5 @@
{
"https://github.com/simplex-chat/simplexmq.git"."44abb90c63dba63ab5f6d379131e5a7e0f625e98" = "16mi6lqgn6b57jv34kx72j5h5ga2x4avpv49dibk3xjqjb041q9a";
"https://github.com/simplex-chat/simplexmq.git"."066d91b0f594e1c9a9c584900cc133e9cec01e55" = "0qy8k0fjqaw16xh2abi8852vxhkm0490vl0ljnlz2bkqgv3iz4qs";
"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";
src/Simplex/Chat.hs
+21 -4
View File
@@ -26,7 +26,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)
import Data.Bifunctor (bimap, first, second)
import qualified Data.ByteString.Base64 as B64
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
@@ -36,12 +36,13 @@ import Data.Either (fromRight, rights)
import Data.Fixed (div')
import Data.Functor (($>))
import Data.Int (Int64)
import Data.List (find, isSuffixOf, partition, sortOn)
import Data.List (find, foldl', isSuffixOf, partition, sortOn)
import Data.List.NonEmpty (NonEmpty, nonEmpty)
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)
@@ -75,7 +76,7 @@ import Simplex.FileTransfer.Client.Presets (defaultXFTPServers)
import Simplex.FileTransfer.Description (ValidFileDescription, gb, kb, mb)
import Simplex.FileTransfer.Protocol (FileParty (..), FilePartyI)
import Simplex.Messaging.Agent as Agent
import Simplex.Messaging.Agent.Client (AgentStatsKey (..), agentClientStore, temporaryAgentError)
import Simplex.Messaging.Agent.Client (AgentStatsKey (..), SubInfo (..), agentClientStore, temporaryAgentError)
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig (..), InitialAgentServers (..), createAgentStore, defaultAgentConfig)
import Simplex.Messaging.Agent.Lock
import Simplex.Messaging.Agent.Protocol
@@ -1733,6 +1734,20 @@ processChatCommand = \case
stat (AgentStatsKey {host, clientTs, cmd, res}, count) =
map B.unpack [host, clientTs, cmd, res, bshow count]
ResetAgentStats -> withAgent resetAgentStats >> ok_
GetAgentSubs -> summary <$> withAgent getAgentSubscriptions
where
summary SubscriptionsInfo {activeSubscriptions, pendingSubscriptions} =
CRAgentSubs {activeSubs, distinctActiveSubs, pendingSubs, distinctPendingSubs}
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'
)
GetAgentSubsDetails -> CRAgentSubsDetails <$> withAgent getAgentSubscriptions
where
withChatLock name action = asks chatLock >>= \l -> withLock l name action
-- below code would make command responses asynchronous where they can be slow
@@ -5262,7 +5277,9 @@ chatCommandP =
("/version" <|> "/v") $> ShowVersion,
"/debug locks" $> DebugLocks,
"/get stats" $> GetAgentStats,
"/reset stats" $> ResetAgentStats
"/reset stats" $> ResetAgentStats,
"/get subs" $> GetAgentSubs,
"/get subs details" $> GetAgentSubsDetails
]
where
choice = A.choice . map (\p -> p <* A.takeWhile (== ' ') <* A.endOfInput)
src/Simplex/Chat/Controller.hs
+5 -1
View File
@@ -48,7 +48,7 @@ import Simplex.Chat.Protocol
import Simplex.Chat.Store (AutoAccept, StoreError, UserContactLink, UserMsgReceiptSettings)
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import Simplex.Messaging.Agent (AgentClient)
import Simplex.Messaging.Agent (AgentClient, SubscriptionsInfo)
import Simplex.Messaging.Agent.Client (AgentLocks, ProtocolTestFailure)
import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, NetworkConfig)
import Simplex.Messaging.Agent.Lock
@@ -406,6 +406,8 @@ data ChatCommand
| DebugLocks
| GetAgentStats
| ResetAgentStats
| GetAgentSubs
| GetAgentSubsDetails
deriving (Show)
data ChatResponse
@@ -568,6 +570,8 @@ 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}
| CRAgentSubsDetails {agentSubs :: SubscriptionsInfo}
| CRConnectionDisabled {connectionEntity :: ConnectionEntity}
| CRAgentRcvQueueDeleted {agentConnId :: AgentConnId, server :: SMPServer, agentQueueId :: AgentQueueId, agentError_ :: Maybe AgentErrorType}
| CRAgentConnDeleted {agentConnId :: AgentConnId}
src/Simplex/Chat/View.hs
+13 -1
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 qualified Data.Map.Strict as M
import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe)
import Data.Text (Text)
import qualified Data.Text as T
@@ -44,7 +45,7 @@ import Simplex.Chat.Styled
import Simplex.Chat.Types
import Simplex.Chat.Types.Preferences
import qualified Simplex.FileTransfer.Protocol as XFTP
import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..))
import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..), SubscriptionsInfo (..))
import Simplex.Messaging.Agent.Env.SQLite (NetworkConfig (..))
import Simplex.Messaging.Agent.Protocol
import Simplex.Messaging.Agent.Store.SQLite.DB (SlowQueryStats (..))
@@ -260,6 +261,17 @@ 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)]
<> ("active subscriptions:" : listSubs activeSubs)
<> ("distinct active subscriptions:" : listSubs distinctActiveSubs)
<> ("pending subscriptions:" : listSubs pendingSubs)
<> ("distinct pending subscriptions:" : listSubs distinctPendingSubs)
where
listSubs = map (\(srv, count) -> plain $ srv <> ": " <> tshow count) . M.assocs
CRAgentSubsDetails SubscriptionsInfo {activeSubscriptions, pendingSubscriptions} ->
("active subscriptions:" : map sShow activeSubscriptions)
<> ("pending subscriptions: " : map sShow pendingSubscriptions)
CRConnectionDisabled entity -> viewConnectionEntityDisabled entity
CRAgentRcvQueueDeleted acId srv aqId err_ ->
[ "completed deleting rcv queue, agent connection id: " <> sShow acId
stack.yaml
+1 -1
View File
@@ -49,7 +49,7 @@ extra-deps:
# - simplexmq-1.0.0@sha256:34b2004728ae396e3ae449cd090ba7410781e2b3cefc59259915f4ca5daa9ea8,8561
# - ../simplexmq
- github: simplex-chat/simplexmq
commit: 44abb90c63dba63ab5f6d379131e5a7e0f625e98
commit: 066d91b0f594e1c9a9c584900cc133e9cec01e55
- github: kazu-yamamoto/http2
commit: b5a1b7200cf5bc7044af34ba325284271f6dff25
# - ../direct-sqlcipher