From 24816b66fe923c697d7628faa47849d4792203c2 Mon Sep 17 00:00:00 2001 From: Evgeny Date: Sun, 9 Aug 2026 16:09:29 +0100 Subject: [PATCH] core: enhance server test result handling with additional server info (#7357) * core: enhance server test result handling with additional server info * simpler * nix --------- Co-authored-by: Ed Asriyan --- cabal.project | 2 +- scripts/nix/sha256map.nix | 2 +- src/Simplex/Chat/Controller.hs | 3 ++- src/Simplex/Chat/Library/Commands.hs | 5 +++-- src/Simplex/Chat/Library/Subscriber.hs | 2 +- src/Simplex/Chat/View.hs | 6 +++++- 6 files changed, 13 insertions(+), 7 deletions(-) diff --git a/cabal.project b/cabal.project index dbb26ad0f2..bdd04fe7d6 100644 --- a/cabal.project +++ b/cabal.project @@ -21,7 +21,7 @@ constraints: zip +disable-bzip2 +disable-zstd source-repository-package type: git location: https://github.com/simplex-chat/simplexmq.git - tag: ee4dd0d8ded0f66f70a8890ce09d69e3610aa276 + tag: e3d53428a0c5776f9682264a56436ce97bc3eff8 source-repository-package type: git diff --git a/scripts/nix/sha256map.nix b/scripts/nix/sha256map.nix index 7e422c51fe..2a39a6baf4 100644 --- a/scripts/nix/sha256map.nix +++ b/scripts/nix/sha256map.nix @@ -1,5 +1,5 @@ { - "https://github.com/simplex-chat/simplexmq.git"."ee4dd0d8ded0f66f70a8890ce09d69e3610aa276" = "0zahz4011adavfz680wkcqvcrl2f9zjdx6dly6yqkcin4bpr6v3k"; + "https://github.com/simplex-chat/simplexmq.git"."e3d53428a0c5776f9682264a56436ce97bc3eff8" = "1i3x4q6sc8w6hndrmmrsgc15di0bz6w29r4y5cr985rvs9c2mx7d"; "https://github.com/simplex-chat/hs-socks.git"."a30cc7a79a08d8108316094f8f2f82a0c5e1ac51" = "0yasvnr7g91k76mjkamvzab2kvlb1g5pspjyjn2fr6v83swjhj38"; "https://github.com/simplex-chat/direct-sqlcipher.git"."f814ee68b16a9447fbb467ccc8f29bdd3546bfd9" = "1ql13f4kfwkbaq7nygkxgw84213i0zm7c1a8hwvramayxl38dq5d"; "https://github.com/simplex-chat/sqlcipher-simple.git"."a46bd361a19376c5211f1058908fc0ae6bf42446" = "1z0r78d8f0812kxbgsm735qf6xx8lvaz27k1a0b4a2m0sshpd5gl"; diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index af20d97bee..e8392b8c42 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -70,6 +70,7 @@ import Simplex.Chat.Types.Shared import Simplex.Chat.Types.UITheme import Simplex.Chat.Util (liftIOEither) import Simplex.FileTransfer.Description (FileDescriptionURI) +import Simplex.Messaging.Server.Information (ServerPublicInfo) import Simplex.Messaging.Agent (AgentClient, DatabaseDiff, SubscriptionsInfo) import Simplex.Messaging.Agent.Client (AgentLocks, AgentQueuesInfo (..), AgentWorkersDetails (..), AgentWorkersSummary (..), ProtocolTestFailure, SMPServerSubs, ServerQueueInfo, UserNetworkInfo) import Simplex.Messaging.Agent.Env.SQLite (AgentConfig, NetworkConfig, ServerCfg, Worker) @@ -781,7 +782,7 @@ data ChatResponse | CRChatItems {user :: User, chatName_ :: Maybe ChatName, chatItems :: [AChatItem]} | CRChatItemInfo {user :: User, chatItem :: AChatItem, chatItemInfo :: ChatItemInfo} | CRChatItemId User (Maybe ChatItemId) - | CRServerTestResult {user :: User, testServer :: AProtoServerWithAuth, testFailure :: Maybe ProtocolTestFailure} + | CRServerTestResult {user :: User, testServer :: AProtoServerWithAuth, testFailure :: Maybe ProtocolTestFailure, serverInfo :: Maybe (Either String ServerPublicInfo)} | CRChatRelayTestResult {user :: User, relayProfile :: Maybe RelayProfile, relayTestFailure :: Maybe RelayTestFailure} | CRServerOperatorConditions {conditions :: ServerOperatorConditions} | CRUserServers {user :: User, userServers :: [UserOperatorServers]} diff --git a/src/Simplex/Chat/Library/Commands.hs b/src/Simplex/Chat/Library/Commands.hs index b8ee83afa4..8a41e7c655 100644 --- a/src/Simplex/Chat/Library/Commands.hs +++ b/src/Simplex/Chat/Library/Commands.hs @@ -1675,8 +1675,9 @@ processChatCommand cxt nm = \case aUserServer (AProtoServerWithAuth p' srv) = case testEquality p p' of Just Refl -> pure $ AUS SDBNew $ newUserServer srv Nothing -> throwCmdError $ "incorrect server protocol: " <> B.unpack (strEncode srv) - APITestProtoServer userId srv@(AProtoServerWithAuth _ server) -> withUserId userId $ \user -> - lift $ CRServerTestResult user srv <$> withAgent' (\a -> testProtocolServer a nm (aUserId user) server) + APITestProtoServer userId srv@(AProtoServerWithAuth _ server) -> withUserId userId $ \user -> do + r <- lift $ withAgent' $ \a -> testProtocolServer a nm (aUserId user) server + pure $ uncurry (CRServerTestResult user srv) $ either ((,Nothing) . Just) (Nothing,) r TestProtoServer srv -> withUser $ \User {userId} -> processChatCommand cxt nm $ APITestProtoServer userId srv APITestChatRelay userId address -> withUserId userId $ \user -> do diff --git a/src/Simplex/Chat/Library/Subscriber.hs b/src/Simplex/Chat/Library/Subscriber.hs index 19d1aeb0a2..6e798f7ab2 100644 --- a/src/Simplex/Chat/Library/Subscriber.hs +++ b/src/Simplex/Chat/Library/Subscriber.hs @@ -3887,7 +3887,7 @@ processAgentMessageConn cxt user@User {userId} corrId agentConnId agentMessage = Just author -> action author Nothing -> messageError $ "x.grp.msg.forward: event " <> tshow tag <> " requires author" - withVerifiedMsg :: MsgEncodingI e => GroupInfo -> Maybe GroupChatScopeInfo -> GroupMember -> ParsedMsg e -> UTCTime -> (VerifiedMsg e -> CM a) -> CM (Maybe a) + withVerifiedMsg :: GroupInfo -> Maybe GroupChatScopeInfo -> GroupMember -> ParsedMsg e -> UTCTime -> (VerifiedMsg e -> CM a) -> CM (Maybe a) withVerifiedMsg gInfo@GroupInfo {membership} scopeInfo member (ParsedMsg _ signedMsg_ chatMsg@ChatMessage {chatMsgEvent}) ts action = case verified of Just verifiedMsg -> Just <$> action verifiedMsg diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 5894d12fd3..72631dc3f8 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -126,7 +126,11 @@ chatResponseToView hu cfg@ChatConfig {logLevel, showReactions, showFullLinks, te CRApiChat u chat _ -> ttyUser u $ if testView then testViewChat chat else [viewJSON chat] CRChatContentTypes cts -> [plain $ "Chat content types: " <> T.intercalate ", " (map (safeDecodeUtf8 . strEncode) cts)] CRChatTags u tags -> ttyUser u [viewJSON tags] - CRServerTestResult u srv testFailure -> ttyUser u $ viewServerTestResult srv testFailure + CRServerTestResult u srv testFailure info -> ttyUser u $ viewServerTestResult srv testFailure <> maybe [] viewServerInfo info + where + viewServerInfo = \case + Left e -> [plain $ "Server Info Error: " <> T.pack e] + Right i -> [plain $ "Server Info: " <> tshow i] CRChatRelayTestResult u relayProfile_ relayTestFailure_ -> ttyUser u $ viewRelayTestResult relayProfile_ relayTestFailure_ CRServerOperatorConditions (ServerOperatorConditions ops _ ca) -> viewServerOperators ops ca CRUserServers u uss -> ttyUser u $ concatMap viewUserServers uss <> (if testView then [] else serversUserHelp)