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 <service.github@asriyan.me>
This commit is contained in:
Evgeny
2026-08-09 16:09:29 +01:00
committed by GitHub
co-authored by Ed Asriyan
parent e04e080a3d
commit 24816b66fe
6 changed files with 13 additions and 7 deletions
+3 -2
View File
@@ -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
+1 -1
View File
@@ -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