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

@@ -106,6 +106,7 @@ mkChatOpts BroadcastBotOpts {coreOptions} =
       optFilesFolder = Nothing,
       showReactions = False,
       allowInstantFiles = True,
+      autoAcceptFileSize = 0,
       muteNotifications = True,
       maintenance = False
     }

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
+      (successes, failures) <- foldM (sendAndCount user logLevel) (0, 0) cts
-          cts = filter (\ct -> isReady ct && directOrUsed ct) contacts
+      timestamp <- liftIO getCurrentTime
-      forM_ cts $ \ct ->
+      pure CRBroadcastSent {user, msgContent = mc, successes, failures, timestamp}
-        void
+    where
-          ( do
+      mc = MCText msg
-              (sndMsg, _) <- sendDirectContactMessage ct (XMsgNew $ MCSimple (extMsgContent mc Nothing))
+      sendAndCount user ll (s, f) ct =
-              saveSndChatItem user (CDDirectSnd ct) sndMsg (CISndMsgContent mc)
+        (sendToContact user ct $> (s + 1, f)) `catchError` \e -> when (ll <= CLLInfo) (toView $ CRChatError (Just user) e) $> (s, f + 1)
-          )
+      sendToContact user ct = do
-          `catchError` (toView . CRChatError (Just user))
+        (sndMsg, _) <- sendDirectContactMessage ct (XMsgNew $ MCSimple (extMsgContent mc Nothing))
-      CRBroadcastSent user mc (length cts) <$> liftIO getCurrentTime
+        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
+          ChatConfig {logLevel} <- asks config
-            processContact user' ct `catchError` (toView . CRChatError (Just user))
+          (successes, failures) <- foldM (processAndCount user' logLevel) (0, 0) contacts
-          pure $ CRUserProfileUpdated user' (fromLocalProfile p) p'
+          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),
+      "/set profile image " *> (UpdateProfileImage . Just . ImageData <$> imageP),
-      "/profile_image" $> UpdateProfileImage Nothing,
+      "/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)),

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}

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 -> Profile -> Int -> Int -> [StyledString]
-viewUserProfileUpdated Profile {displayName = n, fullName, image, contactLink, preferences} Profile {displayName = n', fullName = fullName', image = image', contactLink = contactLink', preferences = prefs'} =
+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 :: MsgContent -> Int -> Int -> CurrentTime -> TimeZone -> UTCTime -> [StyledString]
-viewSentBroadcast mc n ts tz time = prependFirst (highlight' "/feed" <> " (" <> sShow n <> ") " <> ttyMsgTime ts tz time <> " ") (ttyMsgContent mc)
+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

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
+  withNewTestChat tmp "bob" bobProfile $ \bob -> do
-    withNewTestChatOpts tmp testOpts {maintenance = True} "alice" aliceProfile $ \a -> withTestOutput a $ \alice -> 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 ()

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 <message> 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 <message> 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 <message> to send messages"
       (bob </)
@@ -326,7 +331,7 @@ testDeduplicateContactRequestsProfileChange = testChat3 aliceProfile bobProfile
     alice @@@ [("<@bob", "")]
 
     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 </)
@@ -1096,7 +1101,7 @@ testSetContactPrefs = testChat2 aliceProfile bobProfile $
     bob #$> ("/_get chat @2 count=100", chat, startFeatures <> [(0, "Voice messages: enabled for you"), (1, "voice message (00:10)"), (0, "Voice messages: off")])
     (bob </)
     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")])