core: update simplexmq (not to fail batch subscriptions), terminal: log contact errors with -c option (#1890)

This commit is contained in:
Evgeny Poberezkin
2023-02-04 23:13:20 +00:00
committed by GitHub
parent 3c493db613
commit 49b6979ff0
7 changed files with 14 additions and 10 deletions
+9 -4
View File
@@ -1314,7 +1314,7 @@ processChatCommand = \case
updateGroupProfileByName gName $ \p ->
p {groupPreferences = Just . setGroupPreference' SGFTimedMessages pref $ groupPreferences p}
QuitChat -> liftIO exitSuccess
ShowVersion -> pure $ CRVersionInfo $ coreVersionInfo $(buildTimestampQ) $(simplexmqCommitQ)
ShowVersion -> pure $ CRVersionInfo $ coreVersionInfo $(buildTimestampQ) "" -- $(simplexmqCommitQ)
DebugLocks -> do
chatLockName <- atomically . tryReadTMVar =<< asks chatLock
agentLocks <- withAgent debugAgentLocks
@@ -1823,7 +1823,7 @@ subscribeUserConnections agentBatchSubscribe user = do
-- subscribe using batched commands
rs <- withAgent (`agentBatchSubscribe` concat [ctConns, ucConns, mConns, sftConns, rftConns, pcConns])
-- send connection events to view
contactSubsToView rs cts
contactSubsToView rs cts ce
contactLinkSubsToView rs ucs
groupSubsToView rs gs ms ce
sndFileSubsToView rs sfts
@@ -1860,8 +1860,13 @@ subscribeUserConnections agentBatchSubscribe user = do
pcs <- withStore_ getPendingContactConnections
let connIds = map aConnId' pcs
pure (connIds, M.fromList $ zip connIds pcs)
contactSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId Contact -> m ()
contactSubsToView rs = toView . CRContactSubSummary user . map (uncurry ContactSubStatus) . resultsFor rs
contactSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId Contact -> Bool -> m ()
contactSubsToView rs cts ce = do
toView . CRContactSubSummary user $ map (uncurry ContactSubStatus) cRs
when ce $ mapM_ (toView . uncurry (CRContactSubError user)) cErrors
where
cRs = resultsFor rs cts
cErrors = sortOn (\(Contact {localDisplayName = n}, _) -> n) $ filterErrors cRs
contactLinkSubsToView :: Map ConnId (Either AgentErrorType ()) -> Map ConnId UserContact -> m ()
contactLinkSubsToView rs = toView . CRUserContactSubSummary user . map (uncurry UserContactSubStatus) . resultsFor rs
groupSubsToView :: Map ConnId (Either AgentErrorType ()) -> [Group] -> Map ConnId GroupMember -> Bool -> m ()
+1 -1
View File
@@ -430,7 +430,7 @@ data ChatResponse
| CRSubscriptionEnd {user :: User, connectionEntity :: ConnectionEntity}
| CRContactsDisconnected {server :: SMPServer, contactRefs :: [ContactRef]}
| CRContactsSubscribed {server :: SMPServer, contactRefs :: [ContactRef]}
| CRContactSubError {contact :: Contact, chatError :: ChatError} -- TODO delete
| CRContactSubError {user :: User, contact :: Contact, chatError :: ChatError}
| CRContactSubSummary {user :: User, contactSubscriptions :: [ContactSubStatus]}
| CRUserContactSubSummary {user :: User, userContactSubscriptions :: [UserContactSubStatus]}
| CRHostConnected {protocol :: AProtocolType, transportHost :: TransportHost}
+1 -1
View File
@@ -154,7 +154,7 @@ responseToView user_ ChatConfig {logLevel, testView} liveItems ts = \case
CRSubscriptionEnd u acEntity -> ttyUser u [sShow (connId (entityConnection acEntity :: Connection)) <> ": END"]
CRContactsDisconnected srv cs -> [plain $ "server disconnected " <> showSMPServer srv <> " (" <> contactList cs <> ")"]
CRContactsSubscribed srv cs -> [plain $ "server connected " <> showSMPServer srv <> " (" <> contactList cs <> ")"]
CRContactSubError c e -> [ttyContact' c <> ": contact error " <> sShow e]
CRContactSubError u c e -> ttyUser u [ttyContact' c <> ": contact error " <> sShow e]
CRContactSubSummary u summary ->
ttyUser u $ [sShow (length subscribed) <> " contacts connected (use " <> highlight' "/cs" <> " for the list)" | not (null subscribed)] <> viewErrorsSummary errors " contact errors"
where