blade/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2024-12-17 17:20:21 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

core: count successes and failures for batch operations, only log errors in info log-level (#2585)

Browse Source 
* 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>
This commit is contained in:
Evgeny Poberezkin
2023-06-17 10:34:04 +01:00
committed by GitHub
parent e7089d4c2f
commit 53d77b25ed
6 changed files with 69 additions and 44 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat.hs
+21 -16
View File
@@ -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)),