From 53d77b25ed530ac581ee8fe6b9c5b420c2c383bb Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Sat, 17 Jun 2023 10:34:04 +0100 Subject: [PATCH] core: count successes and failures for batch operations, only log errors in info log-level (#2585) * core: count successes and failures for batch operations, only log errors in info log-level * correction Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> --------- Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> --- apps/simplex-broadcast-bot/Options.hs | 1 + src/Simplex/Chat.hs | 37 +++++++++++++++------------ src/Simplex/Chat/Controller.hs | 6 +++-- src/Simplex/Chat/View.hs | 28 ++++++++++++++------ tests/ChatTests/Direct.hs | 10 ++++---- tests/ChatTests/Profiles.hs | 31 ++++++++++++---------- 6 files changed, 69 insertions(+), 44 deletions(-) diff --git a/apps/simplex-broadcast-bot/Options.hs b/apps/simplex-broadcast-bot/Options.hs index f15035fa1..994884760 100644 --- a/apps/simplex-broadcast-bot/Options.hs +++ b/apps/simplex-broadcast-bot/Options.hs @@ -106,6 +106,7 @@ mkChatOpts BroadcastBotOpts {coreOptions} = optFilesFolder = Nothing, showReactions = False, allowInstantFiles = True, + autoAcceptFileSize = 0, muteNotifications = True, maintenance = False } diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 5fe76b929..cd2d5ca70 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -1231,7 +1231,7 @@ processChatCommand = \case let p' = (fromLocalProfile p :: Profile) {contactLink = Nothing} r <- updateProfile_ user p' $ withStore' $ \db -> setUserProfileContactLink db user Nothing let user' = case r of - CRUserProfileUpdated u' _ _ -> u' + CRUserProfileUpdated u' _ _ _ _ -> u' _ -> user pure $ CRUserContactLinkDeleted user' DeleteMyAddress -> withUser $ \User {userId} -> @@ -1264,17 +1264,19 @@ processChatCommand = \case SendLiveMessage chatName msg -> sendTextMessage chatName msg True SendMessageBroadcast msg -> withUser $ \user -> do contacts <- withStore' (`getUserContacts` user) + let cts = filter (\ct -> isReady ct && directOrUsed ct) contacts + ChatConfig {logLevel} <- asks config withChatLock "sendMessageBroadcast" . procCmd $ do - let mc = MCText msg - cts = filter (\ct -> isReady ct && directOrUsed ct) contacts - forM_ cts $ \ct -> - void - ( do - (sndMsg, _) <- sendDirectContactMessage ct (XMsgNew $ MCSimple (extMsgContent mc Nothing)) - saveSndChatItem user (CDDirectSnd ct) sndMsg (CISndMsgContent mc) - ) - `catchError` (toView . CRChatError (Just user)) - CRBroadcastSent user mc (length cts) <$> liftIO getCurrentTime + (successes, failures) <- foldM (sendAndCount user logLevel) (0, 0) cts + timestamp <- liftIO getCurrentTime + pure CRBroadcastSent {user, msgContent = mc, successes, failures, timestamp} + where + mc = MCText msg + sendAndCount user ll (s, f) ct = + (sendToContact user ct $> (s + 1, f)) `catchError` \e -> when (ll <= CLLInfo) (toView $ CRChatError (Just user) e) $> (s, f + 1) + sendToContact user ct = do + (sndMsg, _) <- sendDirectContactMessage ct (XMsgNew $ MCSimple (extMsgContent mc Nothing)) + void $ saveSndChatItem user (CDDirectSnd ct) sndMsg (CISndMsgContent mc) SendMessageQuote cName (AMsgDirection msgDir) quotedMsg msg -> withUser $ \user@User {userId} -> do contactId <- withStore $ \db -> getContactIdByName db user cName quotedItemId <- withStore $ \db -> getDirectChatItemIdByText db userId contactId msgDir quotedMsg @@ -1596,6 +1598,7 @@ processChatCommand = \case UpdateProfileImage image -> withUser $ \user@User {profile} -> do let p = (fromLocalProfile profile :: Profile) {image} updateProfile user p + ShowProfileImage -> withUser $ \user@User {profile} -> pure $ CRUserProfileImage user $ fromLocalProfile profile SetUserFeature (ACF f) allowed -> withUser $ \user@User {profile} -> do let p = (fromLocalProfile profile :: Profile) {preferences = Just . setPreference f (Just allowed) $ preferences' user} updateProfile user p @@ -1756,10 +1759,11 @@ processChatCommand = \case user' <- updateUser asks currentUser >>= atomically . (`writeTVar` Just user') withChatLock "updateProfile" . procCmd $ do - forM_ contacts $ \ct -> do - processContact user' ct `catchError` (toView . CRChatError (Just user)) - pure $ CRUserProfileUpdated user' (fromLocalProfile p) p' + ChatConfig {logLevel} <- asks config + (successes, failures) <- foldM (processAndCount user' logLevel) (0, 0) contacts + pure $ CRUserProfileUpdated user' (fromLocalProfile p) p' successes failures where + processAndCount user' ll (s, f) ct = (processContact user' ct $> (s + 1, f)) `catchError` \e -> when (ll <= CLLInfo) (toView $ CRChatError (Just user) e) $> (s, f + 1) processContact user' ct = do let mergedProfile = userProfileToSend user Nothing $ Just ct ct' = updateMergedPreferences user' ct @@ -4970,8 +4974,9 @@ chatCommandP = ("/reject " <|> "/rc ") *> char_ '@' *> (RejectContact <$> displayName), ("/markdown" <|> "/m") $> ChatHelp HSMarkdown, ("/welcome" <|> "/w") $> Welcome, - "/profile_image " *> (UpdateProfileImage . Just . ImageData <$> imageP), - "/profile_image" $> UpdateProfileImage Nothing, + "/set profile image " *> (UpdateProfileImage . Just . ImageData <$> imageP), + "/delete profile image" $> UpdateProfileImage Nothing, + "/show profile image" $> ShowProfileImage, ("/profile " <|> "/p ") *> (uncurry UpdateProfile <$> profileNames), ("/profile" <|> "/p") $> ShowProfile, "/set voice #" *> (SetGroupFeature (AGF SGFVoice) <$> displayName <*> (A.space *> strP)), diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 3b4d499b3..a95e1835e 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -374,6 +374,7 @@ data ChatCommand | ShowProfile -- UserId (not used in UI) | UpdateProfile ContactName Text -- UserId (not used in UI) | UpdateProfileImage (Maybe ImageData) -- UserId (not used in UI) + | ShowProfileImage | SetUserFeature AChatFeature FeatureAllowed -- UserId (not used in UI) | SetContactFeature AChatFeature ContactName (Maybe FeatureAllowed) | SetGroupFeature AGroupFeature GroupName GroupFeatureEnabled @@ -421,7 +422,7 @@ data ChatResponse | CRChatItemReaction {user :: User, added :: Bool, reaction :: ACIReaction} | CRChatItemDeleted {user :: User, deletedChatItem :: AChatItem, toChatItem :: Maybe AChatItem, byUser :: Bool, timed :: Bool} | CRChatItemDeletedNotFound {user :: User, contact :: Contact, sharedMsgId :: SharedMsgId} - | CRBroadcastSent User MsgContent Int UTCTime + | CRBroadcastSent {user :: User, msgContent :: MsgContent, successes :: Int, failures :: Int, timestamp :: UTCTime} | CRMsgIntegrityError {user :: User, msgError :: MsgErrorType} | CRCmdAccepted {corr :: CorrId} | CRCmdOk {user_ :: Maybe User} @@ -477,7 +478,8 @@ data ChatResponse | CRSndFileCompleteXFTP {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta} | CRSndFileCancelledXFTP {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta} | CRSndFileError {user :: User, chatItem :: AChatItem} - | CRUserProfileUpdated {user :: User, fromProfile :: Profile, toProfile :: Profile} + | CRUserProfileUpdated {user :: User, fromProfile :: Profile, toProfile :: Profile, successes :: Int, failures :: Int} + | CRUserProfileImage {user :: User, profile :: Profile} | CRContactAliasUpdated {user :: User, toContact :: Contact} | CRConnectionAliasUpdated {user :: User, toConnection :: PendingContactConnection} | CRContactPrefsUpdated {user :: User, fromContact :: Contact, toContact :: Contact} diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 0b78c4625..b4ecd228f 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -47,7 +47,6 @@ import qualified Simplex.FileTransfer.Protocol as XFTP import Simplex.Messaging.Agent.Client (ProtocolTestFailure (..), ProtocolTestStep (..)) import Simplex.Messaging.Agent.Env.SQLite (NetworkConfig (..)) import Simplex.Messaging.Agent.Protocol -import Simplex.Messaging.Agent.Store (canAbortRcvSwitch) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Encoding import Simplex.Messaging.Encoding.String @@ -98,7 +97,7 @@ responseToView user_ ChatConfig {logLevel, showReactions, testView} liveItems ts CRChatItemDeleted u (AChatItem _ _ chat deletedItem) toItem byUser timed -> ttyUser u $ unmuted chat deletedItem $ viewItemDelete chat deletedItem toItem byUser timed ts tz testView CRChatItemReaction u added (ACIReaction _ _ chat reaction) -> ttyUser u $ unmutedReaction chat reaction $ viewItemReaction showReactions chat reaction added ts tz CRChatItemDeletedNotFound u Contact {localDisplayName = c} _ -> ttyUser u [ttyFrom $ c <> "> [deleted - original message not found]"] - CRBroadcastSent u mc n t -> ttyUser u $ viewSentBroadcast mc n ts tz t + CRBroadcastSent u mc s f t -> ttyUser u $ viewSentBroadcast mc s f ts tz t CRMsgIntegrityError u mErr -> ttyUser u $ viewMsgIntegrityError mErr CRCmdAccepted _ -> [] CRCmdOk u_ -> ttyUser' u_ ["ok"] @@ -152,7 +151,8 @@ responseToView user_ ChatConfig {logLevel, showReactions, testView} liveItems ts CRRcvFileAcceptedSndCancelled u ft -> ttyUser u $ viewRcvFileSndCancelled ft CRSndFileCancelled u _ ftm fts -> ttyUser u $ viewSndFileCancelled ftm fts CRRcvFileCancelled u _ ft -> ttyUser u $ receivingFile_ "cancelled" ft - CRUserProfileUpdated u p p' -> ttyUser u $ viewUserProfileUpdated p p' + CRUserProfileUpdated u p p' s f -> ttyUser u $ viewUserProfileUpdated p p' s f + CRUserProfileImage u p -> ttyUser u $ viewUserProfileImage p CRContactPrefsUpdated {user = u, fromContact, toContact} -> ttyUser u $ viewUserContactPrefsUpdated u fromContact toContact CRContactAliasUpdated u c -> ttyUser u $ viewContactAliasUpdated c CRConnectionAliasUpdated u c -> ttyUser u $ viewConnectionAliasUpdated c @@ -983,8 +983,8 @@ viewSwitchPhase = \case SPSecured -> "secured new address" SPCompleted -> "changed address" -viewUserProfileUpdated :: Profile -> Profile -> [StyledString] -viewUserProfileUpdated Profile {displayName = n, fullName, image, contactLink, preferences} Profile {displayName = n', fullName = fullName', image = image', contactLink = contactLink', preferences = prefs'} = +viewUserProfileUpdated :: Profile -> Profile -> Int -> Int -> [StyledString] +viewUserProfileUpdated Profile {displayName = n, fullName, image, contactLink, preferences} Profile {displayName = n', fullName = fullName', image = image', contactLink = contactLink', preferences = prefs'} s f = profileUpdated <> viewPrefsUpdated preferences prefs' where profileUpdated @@ -993,7 +993,15 @@ viewUserProfileUpdated Profile {displayName = n, fullName, image, contactLink, p | n == n' && fullName == fullName' = [if isNothing image' then "profile image removed" else "profile image updated"] | n == n' = ["user full name " <> (if T.null fullName' || fullName' == n' then "removed" else "changed to " <> plain fullName') <> notified] | otherwise = ["user profile is changed to " <> ttyFullName n' fullName' <> notified] - notified = " (your contacts are notified)" + notified = " (your " <> sShow s <> " contacts are notified" <> failures <> ")" + failures + | f > 0 = ", " <> sShow f <> " failures" + | otherwise = "" + +viewUserProfileImage :: Profile -> [StyledString] +viewUserProfileImage Profile {image} = case image of + Just (ImageData img) -> ["Profile image:", plain img] + _ -> ["No profile image"] viewUserContactPrefsUpdated :: User -> Contact -> Contact -> [StyledString] viewUserContactPrefsUpdated user ct ct'@Contact {mergedPreferences = cups} @@ -1163,8 +1171,12 @@ viewSentMessage to quote mc ts tz meta@CIMeta {itemEdited, itemDeleted, itemLive Just False -> ttyTo "[LIVE] " _ -> "" -viewSentBroadcast :: MsgContent -> Int -> CurrentTime -> TimeZone -> UTCTime -> [StyledString] -viewSentBroadcast mc n ts tz time = prependFirst (highlight' "/feed" <> " (" <> sShow n <> ") " <> ttyMsgTime ts tz time <> " ") (ttyMsgContent mc) +viewSentBroadcast :: MsgContent -> Int -> Int -> CurrentTime -> TimeZone -> UTCTime -> [StyledString] +viewSentBroadcast mc s f ts tz time = prependFirst (highlight' "/feed" <> " (" <> sShow s <> failures <> ") " <> ttyMsgTime ts tz time <> " ") (ttyMsgContent mc) + where + failures + | f > 0 = ", " <> sShow f <> " failures" + | otherwise = "" viewSentFileInvitation :: StyledString -> CIFile d -> CurrentTime -> TimeZone -> CIMeta c d -> [StyledString] viewSentFileInvitation to CIFile {fileId, filePath, fileStatus} ts tz = case filePath of diff --git a/tests/ChatTests/Direct.hs b/tests/ChatTests/Direct.hs index 9590b5e13..63882ee20 100644 --- a/tests/ChatTests/Direct.hs +++ b/tests/ChatTests/Direct.hs @@ -899,8 +899,8 @@ testMaintenanceModeWithFiles tmp = do testDatabaseEncryption :: HasCallStack => FilePath -> IO () testDatabaseEncryption tmp = do - withNewTestChat tmp "bob" bobProfile $ \b -> withTestOutput b $ \bob -> do - withNewTestChatOpts tmp testOpts {maintenance = True} "alice" aliceProfile $ \a -> withTestOutput a $ \alice -> do + withNewTestChat tmp "bob" bobProfile $ \bob -> do + withNewTestChatOpts tmp testOpts {maintenance = True} "alice" aliceProfile $ \alice -> do alice ##> "/_start" alice <## "chat started" connectUsers alice bob @@ -918,7 +918,7 @@ testDatabaseEncryption tmp = do alice <## "ok" alice ##> "/_start" alice <## "error: chat store changed, please restart chat" - withTestChatOpts tmp (getTestOpts True "mykey") "alice" $ \a -> withTestOutput a $ \alice -> do + withTestChatOpts tmp (getTestOpts True "mykey") "alice" $ \alice -> do alice ##> "/_start" alice <## "chat started" testChatWorking alice bob @@ -930,7 +930,7 @@ testDatabaseEncryption tmp = do alice <## "ok" alice ##> "/_db encryption {\"currentKey\":\"nextkey\",\"newKey\":\"anotherkey\"}" alice <## "ok" - withTestChatOpts tmp (getTestOpts True "anotherkey") "alice" $ \a -> withTestOutput a $ \alice -> do + withTestChatOpts tmp (getTestOpts True "anotherkey") "alice" $ \alice -> do alice ##> "/_start" alice <## "chat started" testChatWorking alice bob @@ -938,7 +938,7 @@ testDatabaseEncryption tmp = do alice <## "chat stopped" alice ##> "/db decrypt anotherkey" alice <## "ok" - withTestChat tmp "alice" $ \a -> withTestOutput a $ \alice -> do + withTestChat tmp "alice" $ \alice -> do testChatWorking alice bob testMuteContact :: HasCallStack => FilePath -> IO () diff --git a/tests/ChatTests/Profiles.hs b/tests/ChatTests/Profiles.hs index ccb638fb1..2b142cb5e 100644 --- a/tests/ChatTests/Profiles.hs +++ b/tests/ChatTests/Profiles.hs @@ -61,19 +61,19 @@ testUpdateProfile = alice <## "(the updated profile will be sent to all your contacts)" alice ##> "/p alice" concurrentlyN_ - [ alice <## "user full name removed (your contacts are notified)", + [ alice <## "user full name removed (your 2 contacts are notified)", bob <## "contact alice removed full name", cath <## "contact alice removed full name" ] alice ##> "/p alice Alice Jones" concurrentlyN_ - [ alice <## "user full name changed to Alice Jones (your contacts are notified)", + [ alice <## "user full name changed to Alice Jones (your 2 contacts are notified)", bob <## "contact alice updated full name: Alice Jones", cath <## "contact alice updated full name: Alice Jones" ] cath ##> "/p cate" concurrentlyN_ - [ cath <## "user profile is changed to cate (your contacts are notified)", + [ cath <## "user profile is changed to cate (your 2 contacts are notified)", do alice <## "contact cath changed to cate" alice <## "use @cate to send messages", @@ -83,7 +83,7 @@ testUpdateProfile = ] cath ##> "/p cat Cate" concurrentlyN_ - [ cath <## "user profile is changed to cat (Cate) (your contacts are notified)", + [ cath <## "user profile is changed to cat (Cate) (your 2 contacts are notified)", do alice <## "contact cate changed to cat (Cate)" alice <## "use @cat to send messages", @@ -97,12 +97,17 @@ testUpdateProfileImage = testChat2 aliceProfile bobProfile $ \alice bob -> do connectUsers alice bob - alice ##> "/profile_image data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=" + alice ##> "/set profile image data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=" alice <## "profile image updated" - alice ##> "/profile_image" + alice ##> "/show profile image" + alice <## "Profile image:" + alice <## "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=" + alice ##> "/delete profile image" alice <## "profile image removed" + alice ##> "/show profile image" + alice <## "No profile image" alice ##> "/_profile 1 {\"displayName\": \"alice2\", \"fullName\": \"\"}" - alice <## "user profile is changed to alice2 (your contacts are notified)" + alice <## "user profile is changed to alice2 (your 1 contacts are notified)" bob <## "contact alice changed to alice2" bob <## "use @alice2 to send messages" (bob "/p bob" - bob <## "user full name removed (your contacts are notified)" + bob <## "user full name removed (your 0 contacts are notified)" bob ##> ("/c " <> cLink) bob <## "connection request sent!" alice <## "bob wants to connect to you!" @@ -335,13 +340,13 @@ testDeduplicateContactRequestsProfileChange = testChat3 aliceProfile bobProfile alice @@@ [("<@bob", "")] bob ##> "/p bob Bob Ross" - bob <## "user full name changed to Bob Ross (your contacts are notified)" + bob <## "user full name changed to Bob Ross (your 0 contacts are notified)" bob ##> ("/c " <> cLink) alice <#? bob alice @@@ [("<@bob", "")] bob ##> "/p robert Robert" - bob <## "user profile is changed to robert (Robert) (your contacts are notified)" + bob <## "user profile is changed to robert (Robert) (your 0 contacts are notified)" bob ##> ("/c " <> cLink) alice <#? bob alice @@@ [("<@robert", "")] @@ -513,7 +518,7 @@ testConnectIncognitoInvitationLink = testChat3 aliceProfile bobProfile cathProfi -- bob is not notified on profile change alice ##> "/p alice" concurrentlyN_ - [ alice <## "user full name removed (your contacts are notified)", + [ alice <## "user full name removed (your 1 contacts are notified)", cath <## "contact alice removed full name" ] alice ?#> ("@" <> bobIncognito <> " do you see that I've changed profile?") @@ -874,7 +879,7 @@ testCantSeeGlobalPrefsUpdateIncognito = testChat3 aliceProfile bobProfile cathPr ] alice <## "cath (Catherine): contact is connected" alice ##> "/_profile 1 {\"displayName\": \"alice\", \"fullName\": \"\", \"preferences\": {\"fullDelete\": {\"allow\": \"always\"}}}" - alice <## "user full name removed (your contacts are notified)" + alice <## "user full name removed (your 1 contacts are notified)" alice <## "updated preferences:" alice <## "Full deletion allowed: always" (alice ("/_get chat @2 count=100", chat, startFeatures <> [(0, "Voice messages: enabled for you"), (1, "voice message (00:10)"), (0, "Voice messages: off")]) (bob "/_profile 1 {\"displayName\": \"bob\", \"fullName\": \"\", \"preferences\": {\"voice\": {\"allow\": \"yes\"}}}" - bob <## "user full name removed (your contacts are notified)" + bob <## "user full name removed (your 1 contacts are notified)" bob <## "updated preferences:" bob <## "Voice messages allowed: yes" bob #$> ("/_get chat @2 count=100", chat, startFeatures <> [(0, "Voice messages: enabled for you"), (1, "voice message (00:10)"), (0, "Voice messages: off"), (1, "Voice messages: enabled")])