From 1d0d7bbd014cdd5671fa9a080ec439e1bfbc1ce8 Mon Sep 17 00:00:00 2001 From: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> Date: Thu, 15 Aug 2024 13:43:57 +0400 Subject: [PATCH 1/2] core: batch send file descriptions (#4684) * core: batch send file descriptions * fix useMember * fix result interpretation * remove comment * refactor --------- Co-authored-by: Evgeny Poberezkin --- src/Simplex/Chat.hs | 70 ++++++++++++++++++++++++++------------------- 1 file changed, 40 insertions(+), 30 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 54b877dc6a..2d3ed3ca84 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -3902,15 +3902,22 @@ processAgentMsgSndFile _corrId aFileId msg = do case (rfds, sfts, d, cInfo) of (rfd : extraRFDs, sft : _, SMDSnd, DirectChat ct) -> do withStore' $ \db -> createExtraSndFTDescrs db user fileId (map fileDescrText extraRFDs) - msgDeliveryId <- sendFileDescription sft rfd sharedMsgId $ sendDirectContactMessage user ct - withStore' $ \db -> updateSndFTDeliveryXFTP db sft msgDeliveryId + conn@Connection {connId} <- liftEither $ contactSendConn_ ct + sendFileDescriptions (ConnectionId connId) ((conn, sft, fileDescrText rfd) :| []) sharedMsgId >>= \case + Just rs -> case L.last rs of + Right ([msgDeliveryId], _) -> + withStore' $ \db -> updateSndFTDeliveryXFTP db sft msgDeliveryId + Right (deliveryIds, _) -> toView $ CRChatError (Just user) $ ChatError $ CEInternalError $ "SFDONE, sendFileDescriptions: expected 1 delivery id, got " <> show (length deliveryIds) + Left e -> toView $ CRChatError (Just user) e + Nothing -> toView $ CRChatError (Just user) $ ChatError $ CEInternalError "SFDONE, sendFileDescriptions: expected at least 1 result" lift $ withAgent' (`xftpDeleteSndFileInternal` aFileId) (_, _, SMDSnd, GroupChat g@GroupInfo {groupId}) -> do ms <- withStore' $ \db -> getGroupMembers db vr user g - let rfdsMemberFTs = zip rfds $ memberFTs ms + let rfdsMemberFTs = zipWith (\rfd (conn, sft) -> (conn, sft, fileDescrText rfd)) rfds (memberFTs ms) extraRFDs = drop (length rfdsMemberFTs) rfds withStore' $ \db -> createExtraSndFTDescrs db user fileId (map fileDescrText extraRFDs) - forM_ rfdsMemberFTs $ \mt -> sendToMember mt `catchChatError` (toView . CRChatError (Just user)) + forM_ (L.nonEmpty rfdsMemberFTs) $ \rfdsMemberFTs' -> + sendFileDescriptions (GroupId groupId) rfdsMemberFTs' sharedMsgId ci' <- withStore $ \db -> do liftIO $ updateCIFileStatus db user fileId CIFSSndComplete getChatItemByFileId db vr user fileId @@ -3922,15 +3929,12 @@ processAgentMsgSndFile _corrId aFileId msg = do where mConns' = mapMaybe useMember ms sfts' = mapMaybe (\sft@SndFileTransfer {groupMemberId} -> (,sft) <$> groupMemberId) sfts + -- Should match memberSendAction logic useMember GroupMember {groupMemberId, activeConn = Just conn@Connection {connStatus}} - | (connStatus == ConnReady || connStatus == ConnSndReady) && not (connDisabled conn) = Just (groupMemberId, conn) + | (connStatus == ConnReady || connStatus == ConnSndReady) && not (connDisabled conn) && not (connInactive conn) = + Just (groupMemberId, conn) | otherwise = Nothing useMember _ = Nothing - sendToMember :: (ValidFileDescription 'FRecipient, (Connection, SndFileTransfer)) -> CM () - sendToMember (rfd, (conn, sft)) = - void $ sendFileDescription sft rfd sharedMsgId $ \msg' -> do - (sndMsg, msgDeliveryId, _) <- sendDirectMemberMessage conn msg' groupId - pure (sndMsg, msgDeliveryId) _ -> pure () _ -> pure () -- TODO error? SFWARN e -> do @@ -3945,20 +3949,27 @@ processAgentMsgSndFile _corrId aFileId msg = do where fileDescrText :: FilePartyI p => ValidFileDescription p -> T.Text fileDescrText = safeDecodeUtf8 . strEncode - sendFileDescription :: SndFileTransfer -> ValidFileDescription 'FRecipient -> SharedMsgId -> (ChatMsgEvent 'Json -> CM (SndMessage, Int64)) -> CM Int64 - sendFileDescription sft rfd msgId sendMsg = do - let rfdText = fileDescrText rfd - withStore' $ \db -> updateSndFTDescrXFTP db user sft rfdText - parts <- splitFileDescr rfdText - loopSend parts + sendFileDescriptions :: ConnOrGroupId -> NonEmpty (Connection, SndFileTransfer, RcvFileDescrText) -> SharedMsgId -> CM (Maybe (NonEmpty (Either ChatError ([Int64], PQEncryption)))) + sendFileDescriptions connOrGroupId connsTransfersDescrs sharedMsgId = do + lift . void . withStoreBatch' $ \db -> L.map (\(_, sft, rfdText) -> updateSndFTDescrXFTP db user sft rfdText) connsTransfersDescrs + partSize <- asks $ xftpDescrPartSize . config + let connsIdsEvts = connDescrEvents partSize + sndMsgs_ <- lift $ createSndMessages $ L.map snd connsIdsEvts + let (errs, msgReqs) = partitionEithers . L.toList $ L.zipWith (fmap . toMsgReq) connsIdsEvts sndMsgs_ + delivered <- mapM deliverMessages (L.nonEmpty msgReqs) + let errs' = errs <> maybe [] (lefts . L.toList) delivered + unless (null errs') $ toView $ CRChatErrors (Just user) errs' + pure delivered where - -- returns msgDeliveryId of the last file description message - loopSend :: NonEmpty FileDescr -> CM Int64 - loopSend (fileDescr :| fds) = do - (_, msgDeliveryId) <- sendMsg $ XMsgFileDescr {msgId, fileDescr} - case L.nonEmpty fds of - Just fds' -> loopSend fds' - Nothing -> pure msgDeliveryId + connDescrEvents :: Int -> NonEmpty (Connection, (ConnOrGroupId, ChatMsgEvent 'Json)) + connDescrEvents partSize = L.fromList $ concatMap splitText (L.toList connsTransfersDescrs) + where + splitText :: (Connection, SndFileTransfer, RcvFileDescrText) -> [(Connection, (ConnOrGroupId, ChatMsgEvent 'Json))] + splitText (conn, _, rfdText) = + map (\fileDescr -> (conn, (connOrGroupId, XMsgFileDescr {msgId = sharedMsgId, fileDescr}))) (L.toList $ splitFileDescr partSize rfdText) + toMsgReq :: (Connection, (ConnOrGroupId, ChatMsgEvent 'Json)) -> SndMessage -> ChatMsgReq + toMsgReq (conn, _) SndMessage {msgId, msgBody} = + (conn, MsgFlags {notification = hasNotification XMsgFileDescr_}, msgBody, [msgId]) sendFileError :: FileError -> Text -> VersionRangeChat -> FileTransferMeta -> CM () sendFileError ferr err vr ft = do logError $ "Sent file error: " <> err @@ -3980,18 +3991,16 @@ agentFileError = \case SMP.TRANSPORT TEVersion -> srvErr SrvErrVersion e -> srvErr . SrvErrOther $ tshow e -splitFileDescr :: RcvFileDescrText -> CM (NonEmpty FileDescr) -splitFileDescr rfdText = do - partSize <- asks $ xftpDescrPartSize . config - pure $ splitParts 1 partSize rfdText +splitFileDescr :: Int -> RcvFileDescrText -> NonEmpty FileDescr +splitFileDescr partSize rfdText = splitParts 1 rfdText where - splitParts partNo partSize remText = + splitParts partNo remText = let (part, rest) = T.splitAt partSize remText complete = T.null rest fileDescr = FileDescr {fileDescrText = part, fileDescrPartNo = partNo, fileDescrComplete = complete} in if complete then fileDescr :| [] - else fileDescr <| splitParts (partNo + 1) partSize rest + else fileDescr <| splitParts (partNo + 1) rest processAgentMsgRcvFile :: ACorrId -> RcvFileId -> AEvent 'AERcvFile -> CM () processAgentMsgRcvFile _corrId aFileId msg = do @@ -4573,7 +4582,8 @@ processAgentMessageConn vr user@User {userId} corrId agentConnId agentMessage = xMsgNewChatMsg = ChatMessage {chatVRange = senderVRange, msgId = itemSharedMsgId, chatMsgEvent = XMsgNew msgContainer} fileDescrEvents <- case (snd <$> fInvDescr_, itemSharedMsgId) of (Just fileDescrText, Just msgId) -> do - parts <- splitFileDescr fileDescrText + partSize <- asks $ xftpDescrPartSize . config + let parts = splitFileDescr partSize fileDescrText pure . toList $ L.map (XMsgFileDescr msgId) parts _ -> pure [] let fileDescrChatMsgs = map (ChatMessage senderVRange Nothing) fileDescrEvents From c159c2ede345aa041337c0da16fa241cb5af2e3c Mon Sep 17 00:00:00 2001 From: Arturs Krumins Date: Thu, 15 Aug 2024 13:15:24 +0300 Subject: [PATCH 2/2] ios: fix pending connection sheet styling when opened via icon; fix tappable area of pending connections and contact requests (#4694) * fix new contact sheet styling * fix contact request tappable area --------- Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com> --- apps/ios/Shared/Views/ChatList/ChatListNavLink.swift | 2 ++ apps/ios/Shared/Views/ChatList/ContactConnectionView.swift | 5 ----- 2 files changed, 2 insertions(+), 5 deletions(-) diff --git a/apps/ios/Shared/Views/ChatList/ChatListNavLink.swift b/apps/ios/Shared/Views/ChatList/ChatListNavLink.swift index c8424ef332..d2a93b9bd1 100644 --- a/apps/ios/Shared/Views/ChatList/ChatListNavLink.swift +++ b/apps/ios/Shared/Views/ChatList/ChatListNavLink.swift @@ -355,6 +355,7 @@ struct ChatListNavLink: View { .tint(.red) } .frame(height: dynamicRowHeight) + .contentShape(Rectangle()) .onTapGesture { showContactRequestDialog = true } .confirmationDialog("Accept connection request?", isPresented: $showContactRequestDialog, titleVisibility: .visible) { Button("Accept") { Task { await acceptContactRequest(incognito: false, contactRequest: contactRequest) } } @@ -392,6 +393,7 @@ struct ChatListNavLink: View { } } } + .contentShape(Rectangle()) .onTapGesture { showContactConnectionInfo = true } diff --git a/apps/ios/Shared/Views/ChatList/ContactConnectionView.swift b/apps/ios/Shared/Views/ChatList/ContactConnectionView.swift index 3c7bf97af9..f5156d86b8 100644 --- a/apps/ios/Shared/Views/ChatList/ContactConnectionView.swift +++ b/apps/ios/Shared/Views/ChatList/ContactConnectionView.swift @@ -16,7 +16,6 @@ struct ContactConnectionView: View { @Environment(\.dynamicTypeSize) private var userFont: DynamicTypeSize @State private var localAlias = "" @FocusState private var aliasTextFieldFocused: Bool - @State private var showContactConnectionInfo = false var body: some View { if case let .contactConnection(conn) = chat.chatInfo { @@ -32,7 +31,6 @@ struct ContactConnectionView: View { .scaledToFill() .frame(width: 48, height: 48) .foregroundColor(Color(uiColor: .tertiarySystemGroupedBackground).asAnotherColorFromSecondaryVariant(theme)) - .onTapGesture { showContactConnectionInfo = true } } .frame(width: 63, height: 63) .padding(.leading, 4) @@ -72,9 +70,6 @@ struct ContactConnectionView: View { Spacer() } .frame(maxHeight: .infinity) - .appSheet(isPresented: $showContactConnectionInfo) { - ContactConnectionInfo(contactConnection: contactConnection) - } } } }