diff --git a/.github/CODEOWNERS b/.github/CODEOWNERS index 9d3e4d2246..9bf5ba8711 100644 --- a/.github/CODEOWNERS +++ b/.github/CODEOWNERS @@ -1 +1 @@ -* @epoberezkin @efim-poberezkin +* @epoberezkin @jr-simplex diff --git a/simplex-chat.cabal b/simplex-chat.cabal index 9af114a67d..9dbb4b6a17 100644 --- a/simplex-chat.cabal +++ b/simplex-chat.cabal @@ -34,7 +34,7 @@ library Simplex.Chat.Migrations.M20220302_profile_images Simplex.Chat.Migrations.M20220304_msg_quotes Simplex.Chat.Migrations.M20220321_chat_item_edited - Simplex.Chat.Migrations.M20220404_files_cancelled + Simplex.Chat.Migrations.M20220404_files_status_fields Simplex.Chat.Mobile Simplex.Chat.Options Simplex.Chat.Protocol diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index 369538f2fb..e93abdedec 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -174,49 +174,84 @@ processChatCommand = \case CTGroup -> CRApiChat . AChat SCTGroup <$> withStore (\st -> getGroupChat st user cId pagination) CTContactRequest -> pure $ chatCmdError "not implemented" APIGetChatItems _pagination -> pure $ chatCmdError "not implemented" - APISendMessage cType chatId _file mc -> withUser $ \user@User {userId} -> withChatLock $ case cType of - -- TODO send message with file attachment; initiate file transfer + APISendMessage cType chatId file_ quotedItemId_ mc -> withUser $ \user@User {userId} -> withChatLock $ case cType of CTDirect -> do - ct <- withStore $ \st -> getContact st userId chatId - sendNewMsg user ct (MCSimple (ExtMsgContent mc Nothing)) mc Nothing - CTGroup -> do - group@(Group GroupInfo {membership} _) <- withStore $ \st -> getGroup st user chatId - unless (memberActive membership) $ throwChatError CEGroupMemberUserRemoved - sendNewGroupMsg user group (MCSimple (ExtMsgContent mc Nothing)) mc Nothing - CTContactRequest -> pure $ chatCmdError "not supported" - APISendMessageQuote cType chatId quotedItemId _file mc -> withUser $ \user@User {userId} -> withChatLock $ case cType of - -- TODO send message with file attachment; initiate file transfer - CTDirect -> do - (ct, qci) <- withStore $ \st -> (,) <$> getContact st userId chatId <*> getDirectChatItem st userId chatId quotedItemId - case qci of - CChatItem _ ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, content = ciContent, formattedText} -> do - case ciContent of - CISndMsgContent qmc -> send_ CIQDirectSnd True qmc - CIRcvMsgContent qmc -> send_ CIQDirectRcv False qmc - _ -> throwChatError CEInvalidQuote + ct@Contact {localDisplayName = c} <- withStore $ \st -> getContact st userId chatId + (fileInvitation_, ciFile_) <- unzipMaybe <$> setupSndFileTransfer ct + (msgContainer, quotedItem_) <- prepareMsg fileInvitation_ + msg <- sendDirectContactMessage ct (XMsgNew msgContainer) + ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc) ciFile_ quotedItem_ + setActive $ ActiveC c + pure . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat ct) ci + where + setupSndFileTransfer :: Contact -> m (Maybe (FileInvitation, CIFile 'MDSnd)) + setupSndFileTransfer ct = case file_ of + Nothing -> pure Nothing + Just file -> do + (fileSize, chSize) <- checkSndFile file + (agentConnId, fileConnReq) <- withAgent (`createConnection` SCMInvitation) + let fileName = takeFileName file + fileInvitation = FileInvitation {fileName, fileSize, fileConnReq = Just fileConnReq} + fileId <- withStore $ \st -> createSndFileTransfer st userId ct file fileInvitation agentConnId chSize + let ciFile = CIFile {fileId, fileName, fileSize, filePath = Just file, fileStatus = CIFSSndStored} + pure $ Just (fileInvitation, ciFile) + prepareMsg :: Maybe FileInvitation -> m (MsgContainer, Maybe (CIQuote 'CTDirect)) + prepareMsg fileInvitation_ = case quotedItemId_ of + Nothing -> pure (MCSimple (ExtMsgContent mc fileInvitation_), Nothing) + Just quotedItemId -> do + CChatItem _ ChatItem {meta = CIMeta {itemTs, itemSharedMsgId}, content = ciContent, formattedText} <- + withStore $ \st -> getDirectChatItem st userId chatId quotedItemId + (qmc, qd, sent) <- liftEither $ quoteData ciContent + let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Nothing} + quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText} + pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fileInvitation_), Just quotedItem) where - send_ :: CIQDirection 'CTDirect -> Bool -> MsgContent -> m ChatResponse - send_ chatDir sent qmc = - let quotedItem = CIQuote {chatDir, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText} - msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Nothing} - in sendNewMsg user ct (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc Nothing)) mc (Just quotedItem) + quoteData :: CIContent d -> Either ChatError (MsgContent, CIQDirection 'CTDirect, Bool) + quoteData (CISndMsgContent qmc) = Right (qmc, CIQDirectSnd, True) + quoteData (CIRcvMsgContent qmc) = Right (qmc, CIQDirectRcv, False) + quoteData _ = Left $ ChatError CEInvalidQuote CTGroup -> do - group@(Group GroupInfo {membership} _) <- withStore $ \st -> getGroup st user chatId + Group gInfo@GroupInfo {membership, localDisplayName = gName} ms <- withStore $ \st -> getGroup st user chatId unless (memberActive membership) $ throwChatError CEGroupMemberUserRemoved - qci <- withStore $ \st -> getGroupChatItem st user chatId quotedItemId - case qci of - CChatItem _ ChatItem {chatDir, meta = CIMeta {itemTs, itemSharedMsgId}, content = ciContent, formattedText} -> do - case (ciContent, chatDir) of - (CISndMsgContent qmc, _) -> send_ CIQGroupSnd True membership qmc - (CIRcvMsgContent qmc, CIGroupRcv m) -> send_ (CIQGroupRcv $ Just m) False m qmc - _ -> throwChatError CEInvalidQuote + (fileInvitation_, ciFile_) <- unzipMaybe <$> setupSndFileTransfer gInfo + (msgContainer, quotedItem_) <- prepareMsg fileInvitation_ membership + msg <- sendGroupMessage gInfo ms (XMsgNew msgContainer) + ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndMsgContent mc) ciFile_ quotedItem_ + setActive $ ActiveG gName + pure . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci + where + setupSndFileTransfer :: GroupInfo -> m (Maybe (FileInvitation, CIFile 'MDSnd)) + setupSndFileTransfer gInfo = case file_ of + Nothing -> pure Nothing + Just file -> do + (fileSize, chSize) <- checkSndFile file + let fileName = takeFileName file + fileInvitation = FileInvitation {fileName, fileSize, fileConnReq = Nothing} + fileId <- withStore $ \st -> createSndGroupFileTransferV2 st userId gInfo file fileInvitation chSize + let ciFile = CIFile {fileId, fileName, fileSize, filePath = Just file, fileStatus = CIFSSndStored} + pure $ Just (fileInvitation, ciFile) + prepareMsg :: Maybe FileInvitation -> GroupMember -> m (MsgContainer, Maybe (CIQuote 'CTGroup)) + prepareMsg fileInvitation_ membership = case quotedItemId_ of + Nothing -> pure (MCSimple (ExtMsgContent mc fileInvitation_), Nothing) + Just quotedItemId -> do + CChatItem _ ChatItem {chatDir, meta = CIMeta {itemTs, itemSharedMsgId}, content = ciContent, formattedText} <- + withStore $ \st -> getGroupChatItem st user chatId quotedItemId + (qmc, qd, sent, GroupMember {memberId}) <- liftEither $ quoteData ciContent chatDir membership + let msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Just memberId} + quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content = qmc, formattedText} + pure (MCQuote QuotedMsg {msgRef, content = qmc} (ExtMsgContent mc fileInvitation_), Just quotedItem) where - send_ :: CIQDirection 'CTGroup -> Bool -> GroupMember -> MsgContent -> m ChatResponse - send_ qd sent GroupMember {memberId} content = - let quotedItem = CIQuote {chatDir = qd, itemId = Just quotedItemId, sharedMsgId = itemSharedMsgId, sentAt = itemTs, content, formattedText} - msgRef = MsgRef {msgId = itemSharedMsgId, sentAt = itemTs, sent, memberId = Just memberId} - in sendNewGroupMsg user group (MCQuote QuotedMsg {msgRef, content} (ExtMsgContent mc Nothing)) mc (Just quotedItem) + quoteData :: CIContent d -> CIDirection 'CTGroup d -> GroupMember -> Either ChatError (MsgContent, CIQDirection 'CTGroup, Bool, GroupMember) + quoteData (CISndMsgContent qmc) CIGroupSnd membership' = Right (qmc, CIQGroupSnd, True, membership') + quoteData (CIRcvMsgContent qmc) (CIGroupRcv m) _ = Right (qmc, CIQGroupRcv $ Just m, False, m) + quoteData _ _ _ = Left $ ChatError CEInvalidQuote CTContactRequest -> pure $ chatCmdError "not supported" + where + unzipMaybe :: Maybe (a, b) -> (Maybe a, Maybe b) + unzipMaybe t = (fst <$> t, snd <$> t) + -- TODO discontinue + APISendMessageQuote cType chatId quotedItemId mc -> + processChatCommand $ APISendMessage cType chatId Nothing (Just quotedItemId) mc APIUpdateChatItem cType chatId itemId mc -> withUser $ \user@User {userId} -> withChatLock $ case cType of CTDirect -> do (ct@Contact {contactId, localDisplayName = c}, ci) <- withStore $ \st -> (,) <$> getContact st userId chatId <*> getDirectChatItem st userId chatId itemId @@ -352,21 +387,25 @@ processChatCommand = \case SendMessage cName msg -> withUser $ \User {userId} -> do contactId <- withStore $ \st -> getContactIdByName st userId cName let mc = MCText $ safeDecodeUtf8 msg - processChatCommand $ APISendMessage CTDirect contactId Nothing mc + processChatCommand $ APISendMessage CTDirect contactId Nothing Nothing mc SendMessageBroadcast msg -> withUser $ \user -> do contacts <- withStore (`getUserContacts` user) withChatLock . procCmd $ do let mc = MCText $ safeDecodeUtf8 msg cts = filter isReady contacts forM_ cts $ \ct -> - void (sendDirectChatItem user ct (XMsgNew $ MCSimple (ExtMsgContent mc Nothing)) (CISndMsgContent mc) Nothing) + void + ( do + sndMsg <- sendDirectContactMessage ct (XMsgNew $ MCSimple (ExtMsgContent mc Nothing)) + saveSndChatItem user (CDDirectSnd ct) sndMsg (CISndMsgContent mc) Nothing Nothing + ) `catchError` (toView . CRChatError) CRBroadcastSent mc (length cts) <$> liftIO getZonedTime SendMessageQuote cName (AMsgDirection msgDir) quotedMsg msg -> withUser $ \User {userId} -> do contactId <- withStore $ \st -> getContactIdByName st userId cName quotedItemId <- withStore $ \st -> getDirectChatItemIdByText st userId contactId msgDir (safeDecodeUtf8 quotedMsg) let mc = MCText $ safeDecodeUtf8 msg - processChatCommand $ APISendMessageQuote CTDirect contactId quotedItemId Nothing mc + processChatCommand $ APISendMessage CTDirect contactId Nothing (Just quotedItemId) mc DeleteMessage cName deletedMsg -> withUser $ \User {userId} -> do contactId <- withStore $ \st -> getContactIdByName st userId cName deletedItemId <- withStore $ \st -> getDirectChatItemIdByText st userId contactId SMDSnd (safeDecodeUtf8 deletedMsg) @@ -450,12 +489,12 @@ processChatCommand = \case SendGroupMessage gName msg -> withUser $ \user -> do groupId <- withStore $ \st -> getGroupIdByName st user gName let mc = MCText $ safeDecodeUtf8 msg - processChatCommand $ APISendMessage CTGroup groupId Nothing mc + processChatCommand $ APISendMessage CTGroup groupId Nothing Nothing mc SendGroupMessageQuote gName cName quotedMsg msg -> withUser $ \user -> do groupId <- withStore $ \st -> getGroupIdByName st user gName quotedItemId <- withStore $ \st -> getGroupChatItemIdByText st user groupId cName (safeDecodeUtf8 quotedMsg) let mc = MCText $ safeDecodeUtf8 msg - processChatCommand $ APISendMessageQuote CTGroup groupId quotedItemId Nothing mc + processChatCommand $ APISendMessage CTGroup groupId Nothing (Just quotedItemId) mc DeleteGroupMessage gName deletedMsg -> withUser $ \user@User {localDisplayName} -> do groupId <- withStore $ \st -> getGroupIdByName st user gName deletedItemId <- withStore $ \st -> getGroupChatItemIdByText st user groupId (Just localDisplayName) (safeDecodeUtf8 deletedMsg) @@ -466,110 +505,88 @@ processChatCommand = \case let mc = MCText $ safeDecodeUtf8 msg processChatCommand $ APIUpdateChatItem CTGroup groupId editedItemId mc -- old file protocol + -- SendFile cName f -> withUser $ \User {userId} -> do + -- contactId <- withStore $ \st -> getContactIdByName st userId cName + -- processChatCommand $ APISendMessage CTDirect contactId (Just f) Nothing (MCText "") + -- TODO replace with code above when switching from XFile SendFile cName f -> withUser $ \user@User {userId} -> withChatLock $ do (fileSize, chSize) <- checkSndFile f contact <- withStore $ \st -> getContactByName st userId cName (agentConnId, fileConnReq) <- withAgent (`createConnection` SCMInvitation) - let fileInv = FileInvitation {fileName = takeFileName f, fileSize, fileConnReq = Just fileConnReq} - SndFileTransfer {fileId} <- withStore $ \st -> + let fileName = takeFileName f + fileInv = FileInvitation {fileName = takeFileName f, fileSize, fileConnReq = Just fileConnReq} + fileId <- withStore $ \st -> createSndFileTransfer st userId contact f fileInv agentConnId chSize - ci <- sendDirectChatItem user contact (XFile fileInv) (CISndFileInvitation fileId f) Nothing + msg <- sendDirectContactMessage contact (XFile fileInv) + let ciFile = CIFile {fileId, fileName, fileSize, filePath = Just f, fileStatus = CIFSSndStored} + ci <- saveSndChatItem user (CDDirectSnd contact) msg (CISndMsgContent $ MCText "") (Just ciFile) Nothing withStore $ \st -> updateFileTransferChatItemId st fileId $ chatItemId' ci setActive $ ActiveC cName pure . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat contact) ci - -- new file protocol + -- new file protocol (not used for direct files) SendFileInv cName f -> withUser $ \user@User {userId} -> withChatLock $ do + ct <- withStore $ \st -> getContactByName st userId cName (fileSize, chSize) <- checkSndFile f - contact <- withStore $ \st -> getContactByName st userId cName - let fileInv = FileInvitation {fileName = takeFileName f, fileSize, fileConnReq = Nothing} - fileId <- withStore $ \st -> createSndFileTransferV2 st userId contact f fileInv chSize - ci <- sendDirectChatItem user contact (XFile fileInv) (CISndFileInvitation fileId f) Nothing - withStore $ \st -> updateFileTransferChatItemId st fileId $ chatItemId' ci + let fileName = takeFileName f + fileInvitation = FileInvitation {fileName, fileSize, fileConnReq = Nothing} + fileId <- withStore $ \st -> createSndFileTransferV2 st userId ct f fileInvitation chSize + let mc = MCText "" + ciFile = Just $ CIFile {fileId, fileName, fileSize, filePath = Just f, fileStatus = CIFSSndStored} + msg <- sendDirectContactMessage ct (XMsgNew (MCSimple (ExtMsgContent mc (Just fileInvitation)))) + ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndMsgContent mc) ciFile Nothing setActive $ ActiveC cName - pure . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat contact) ci + pure . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat ct) ci -- old file protocol + -- TODO discontinue SendGroupFile gName f -> withUser $ \user@User {userId} -> withChatLock $ do - (fileSize, chSize) <- checkSndFile f Group gInfo@GroupInfo {groupId, membership} members <- withStore $ \st -> getGroupByName st user gName unless (memberActive membership) $ throwChatError CEGroupMemberUserRemoved + (fileSize, chSize) <- checkSndFile f let fileName = takeFileName f ms <- forM (filter memberActive members) $ \m -> do (connId, fileConnReq) <- withAgent (`createConnection` SCMInvitation) pure (m, connId, FileInvitation {fileName, fileSize, fileConnReq = Just fileConnReq}) fileId <- withStore $ \st -> createSndGroupFileTransfer st userId gInfo ms f fileSize chSize - -- TODO sendGroupChatItem - same file invitation to all - forM_ ms $ \(m, _, fileInv) -> - traverse (\conn -> sendDirectMessage conn (XFile fileInv) (GroupId groupId)) $ memberConn m + forM_ ms $ \(m, _, fileInvitation) -> + traverse (\conn -> sendDirectMessage conn (XFile fileInvitation) (GroupId groupId)) $ memberConn m setActive $ ActiveG gName -- this is a hack as we have multiple direct messages instead of one per group let msg = SndMessage {msgId = 0, sharedMsgId = SharedMsgId "", msgBody = ""} - ciContent = CISndFileInvitation fileId f - cItem@ChatItem {meta = CIMeta {itemId}} <- saveSndChatItem user (CDGroupSnd gInfo) msg ciContent Nothing - withStore $ \st -> updateFileTransferChatItemId st fileId itemId - pure . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) cItem - -- new file protocol - SendGroupFileInv gName f -> withUser $ \user@User {userId} -> withChatLock $ do - (fileSize, chSize) <- checkSndFile f - g@(Group gInfo@GroupInfo {membership} _) <- withStore $ \st -> getGroupByName st user gName - unless (memberActive membership) $ throwChatError CEGroupMemberUserRemoved - let fileInv = FileInvitation {fileName = takeFileName f, fileSize, fileConnReq = Nothing} - fileId <- withStore $ \st -> createSndGroupFileTransferV2 st userId gInfo f fileInv chSize - ci <- sendGroupChatItem user g (XFile fileInv) (CISndFileInvitation fileId f) Nothing - withStore $ \st -> updateFileTransferChatItemId st fileId $ chatItemId' ci - setActive $ ActiveG gName + ciFile = Just $ CIFile {fileId, fileName, fileSize, filePath = Just f, fileStatus = CIFSSndStored} + ci <- saveSndChatItem user (CDGroupSnd gInfo) msg (CISndMsgContent $ MCText "") ciFile Nothing pure . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci - ReceiveFile fileId filePath_ -> withUser $ \user@User {userId} -> do - ft@RcvFileTransfer {fileInvitation = FileInvitation {fileName, fileConnReq}, fileStatus, senderDisplayName, grpMemberId} <- withStore $ \st -> getRcvFileTransfer st userId fileId - unless (fileStatus == RFSNew) . throwChatError $ CEFileAlreadyReceiving fileName - case fileConnReq of - -- old file protocol - Just connReq -> - withChatLock . procCmd $ do - tryError (withAgent $ \a -> joinConnection a connReq . directMessage $ XFileAcpt fileName) >>= \case - Right agentConnId -> do - filePath <- getRcvFilePath fileId filePath_ fileName - withStore $ \st -> acceptRcvFileTransfer st userId fileId agentConnId filePath - pure $ CRRcvFileAccepted ft filePath - Left (ChatErrorAgent (SMP SMP.AUTH)) -> pure $ CRRcvFileAcceptedSndCancelled ft - Left (ChatErrorAgent (CONN DUPLICATE)) -> pure $ CRRcvFileAcceptedSndCancelled ft - Left e -> throwError e - -- new file protocol - Nothing -> - case grpMemberId of - Nothing -> - withChatLock . procCmd $ do - ct <- withStore $ \st -> getContactByName st userId senderDisplayName - acceptFileV2 $ \sharedMsgId fileInvConnReq -> sendDirectContactMessage ct $ XFileAcptInv sharedMsgId fileInvConnReq fileName - Just memId -> - withChatLock . procCmd $ do - (GroupInfo {groupId}, GroupMember {activeConn}) <- withStore $ \st -> getGroupAndMember st user memId - case activeConn of - Just conn -> - acceptFileV2 $ \sharedMsgId fileInvConnReq -> sendDirectMessage conn (XFileAcptInv sharedMsgId fileInvConnReq fileName) (GroupId groupId) - _ -> throwChatError $ CEFileInternal "member connection not active" -- should not happen - where - acceptFileV2 :: (SharedMsgId -> ConnReqInvitation -> m SndMessage) -> m ChatResponse - acceptFileV2 sendXFileAcptInv = do - sharedMsgId <- withStore $ \st -> getSharedMsgIdByFileId st userId fileId - (agentConnId, fileInvConnReq) <- withAgent (`createConnection` SCMInvitation) - filePath <- getRcvFilePath fileId filePath_ fileName - withStore $ \st -> acceptRcvFileTransfer st userId fileId agentConnId filePath - void $ sendXFileAcptInv sharedMsgId fileInvConnReq - pure $ CRRcvFileAccepted ft filePath + -- new file protocol + SendGroupFileInv gName f -> withUser $ \user -> do + groupId <- withStore $ \st -> getGroupIdByName st user gName + processChatCommand $ APISendMessage CTGroup groupId (Just f) Nothing (MCText "") + ReceiveFile fileId filePath_ -> withUser $ \user@User {userId} -> + withChatLock . procCmd $ do + ft <- withStore $ \st -> getRcvFileTransfer st userId fileId + (CRRcvFileAccepted ft <$> acceptFileReceive user ft filePath_) `catchError` processError ft + where + processError ft = \case + ChatErrorAgent (SMP SMP.AUTH) -> pure $ CRRcvFileAcceptedSndCancelled ft + ChatErrorAgent (CONN DUPLICATE) -> pure $ CRRcvFileAcceptedSndCancelled ft + e -> throwError e CancelFile fileId -> withUser $ \User {userId} -> do ft' <- withStore (\st -> getFileTransfer st userId fileId) withChatLock . procCmd $ do - unless (fileTransferCancelled ft') $ - withStore $ \st -> updateFileCancelled st userId fileId case ft' of - FTSnd ftm [] -> do - pure $ CRSndGroupFileCancelled ftm [] FTSnd ftm fts -> do + cancelFileTransfer userId ft' CIFSSndCancelled forM_ fts $ \ft -> cancelSndFileTransfer ft pure $ CRSndGroupFileCancelled ftm fts FTRcv ft -> do + cancelFileTransfer userId ft' CIFSRcvCancelled cancelRcvFileTransfer ft pure $ CRRcvFileCancelled ft + where + cancelFileTransfer :: MsgDirectionI d => UserId -> FileTransfer -> CIFileStatus d -> m () + cancelFileTransfer userId ft ciFileStatus = + unless (fileTransferCancelled ft) $ + withStore $ \st -> do + updateFileCancelled st userId fileId + updateCIFileStatus st userId fileId ciFileStatus FileStatus fileId -> CRFileTransferStatus <$> withUser (\User {userId} -> withStore $ \st -> getFileTransferProgress st userId fileId) ShowProfile -> withUser $ \User {profile} -> pure $ CRUserProfile profile @@ -609,14 +626,6 @@ processChatCommand = \case connId <- withAgent $ \a -> joinConnection a cReq $ directMessage (XContact profile $ Just xContactId) withStore $ \st -> createConnReqConnection st userId connId cReqHash xContactId pure CRSentInvitation - sendNewMsg user ct@Contact {localDisplayName = c} msgContainer mc quotedItem = do - ci <- sendDirectChatItem user ct (XMsgNew msgContainer) (CISndMsgContent mc) quotedItem - setActive $ ActiveC c - pure . CRNewChatItem $ AChatItem SCTDirect SMDSnd (DirectChat ct) ci - sendNewGroupMsg user g@(Group gInfo@GroupInfo {localDisplayName = gName} _) msgContainer mc quotedItem = do - ci <- sendGroupChatItem user g (XMsgNew msgContainer) (CISndMsgContent mc) quotedItem - setActive $ ActiveG gName - pure . CRNewChatItem $ AChatItem SCTGroup SMDSnd (GroupChat gInfo) ci contactMember :: Contact -> [GroupMember] -> Maybe GroupMember contactMember Contact {contactId} = find $ \GroupMember {memberContactId = cId, memberStatus = s} -> @@ -641,17 +650,52 @@ processChatCommand = \case isReady ct = let s = connStatus $ activeConn (ct :: Contact) in s == ConnReady || s == ConnSndReady - getRcvFilePath :: Int64 -> Maybe FilePath -> String -> m FilePath - getRcvFilePath fileId filePath fileName = case filePath of + +acceptFileReceive :: forall m. ChatMonad m => User -> RcvFileTransfer -> Maybe FilePath -> m FilePath +acceptFileReceive user@User {userId} RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName = fName, fileConnReq}, fileStatus, senderDisplayName, grpMemberId} filePath_ = do + unless (fileStatus == RFSNew) . throwChatError $ CEFileAlreadyReceiving fName + case fileConnReq of + -- old file protocol + Just connReq -> + tryError (withAgent $ \a -> joinConnection a connReq . directMessage $ XFileAcpt fName) >>= \case + Right agentConnId -> do + filePath <- getRcvFilePath filePath_ fName + withStore $ \st -> acceptRcvFileTransfer st userId fileId agentConnId filePath + pure filePath + Left e -> throwError e + -- new file protocol + Nothing -> + case grpMemberId of + Nothing -> do + ct <- withStore $ \st -> getContactByName st userId senderDisplayName + acceptFileV2 $ \sharedMsgId fileInvConnReq -> sendDirectContactMessage ct $ XFileAcptInv sharedMsgId fileInvConnReq fName + Just memId -> do + (GroupInfo {groupId}, GroupMember {activeConn}) <- withStore $ \st -> getGroupAndMember st user memId + case activeConn of + Just conn -> + acceptFileV2 $ \sharedMsgId fileInvConnReq -> sendDirectMessage conn (XFileAcptInv sharedMsgId fileInvConnReq fName) (GroupId groupId) + _ -> throwChatError $ CEFileInternal "member connection not active" -- should not happen + where + acceptFileV2 :: (SharedMsgId -> ConnReqInvitation -> m SndMessage) -> m FilePath + acceptFileV2 sendXFileAcptInv = do + sharedMsgId <- withStore $ \st -> getSharedMsgIdByFileId st userId fileId + (agentConnId, fileInvConnReq) <- withAgent (`createConnection` SCMInvitation) + filePath <- getRcvFilePath filePath_ fName + withStore $ \st -> acceptRcvFileTransfer st userId fileId agentConnId filePath + void $ sendXFileAcptInv sharedMsgId fileInvConnReq + pure filePath + where + getRcvFilePath :: Maybe FilePath -> String -> m FilePath + getRcvFilePath fPath_ fn = case fPath_ of Nothing -> do dir <- (`combine` "Downloads") <$> getHomeDirectory ifM (doesDirectoryExist dir) (pure dir) getTemporaryDirectory - >>= (`uniqueCombine` fileName) + >>= (`uniqueCombine` fn) >>= createEmptyFile Just fPath -> ifM (doesDirectoryExist fPath) - (fPath `uniqueCombine` fileName >>= createEmptyFile) + (fPath `uniqueCombine` fn >>= createEmptyFile) $ ifM (doesFileExist fPath) (throwChatError $ CEFileAlreadyExists fPath) @@ -664,14 +708,14 @@ processChatCommand = \case h <- getFileHandle fileId fPath rcvFiles AppendMode liftIO $ B.hPut h "" >> hFlush h pure fPath - uniqueCombine :: FilePath -> String -> m FilePath - uniqueCombine filePath fileName = tryCombine (0 :: Int) - where - tryCombine n = - let (name, ext) = splitExtensions fileName - suffix = if n == 0 then "" else "_" <> show n - f = filePath `combine` (name <> suffix <> ext) - in ifM (doesFileExist f) (tryCombine $ n + 1) (pure f) + uniqueCombine :: FilePath -> String -> m FilePath + uniqueCombine filePath fileName = tryCombine (0 :: Int) + where + tryCombine n = + let (name, ext) = splitExtensions fileName + suffix = if n == 0 then "" else "_" <> show n + f = filePath `combine` (name <> suffix <> ext) + in ifM (doesFileExist f) (tryCombine $ n + 1) (pure f) acceptContactRequest :: ChatMonad m => User -> UserContactRequest -> m Contact acceptContactRequest User {userId, profile} UserContactRequest {agentInvitationId = AgentInvId invId, localDisplayName = cName, profileId, profile = p, xContactId} = do @@ -827,7 +871,8 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage XMsgNew mc -> newContentMessage ct mc msg msgMeta XMsgUpdate sharedMsgId mContent -> messageUpdate ct sharedMsgId mContent msg msgMeta XMsgDel sharedMsgId -> messageDelete ct sharedMsgId msg msgMeta - XFile fInv -> processFileInvitation ct fInv msg msgMeta + -- TODO discontinue XFile + XFile fInv -> processFileInvitation' ct fInv msg msgMeta XFileAcptInv sharedMsgId fileConnReq fName -> xFileAcptInv ct sharedMsgId fileConnReq fName msgMeta XInfo p -> xInfo ct p XGrpInv gInv -> processGroupInvitation ct gInv @@ -969,7 +1014,8 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage XMsgNew mc -> newGroupContentMessage gInfo m mc msg msgMeta XMsgUpdate sharedMsgId mContent -> groupMessageUpdate gInfo m sharedMsgId mContent msg XMsgDel sharedMsgId -> groupMessageDelete gInfo m sharedMsgId msg - XFile fInv -> processGroupFileInvitation gInfo m fInv msg msgMeta + -- TODO discontinue XFile + XFile fInv -> processGroupFileInvitation' gInfo m fInv msg msgMeta XFileAcptInv sharedMsgId fileConnReq fName -> xFileAcptInvGroup gInfo m sharedMsgId fileConnReq fName msgMeta XGrpMemNew memInfo -> xGrpMemNew gInfo m memInfo XGrpMemIntro memInfo -> xGrpMemIntro conn gInfo m memInfo @@ -1056,6 +1102,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage appendFileChunk ft chunkNo chunk withStore $ \st -> do updateRcvFileStatus st ft FSComplete + updateCIFileStatus st userId fileId CIFSRcvComplete deleteRcvFileChunks st ft toView $ CRRcvFileComplete ft closeFileHandle fileId rcvFiles @@ -1148,13 +1195,24 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage newContentMessage :: Contact -> MsgContainer -> RcvMessage -> MsgMeta -> m () newContentMessage ct@Contact {localDisplayName = c} mc msg msgMeta = do - let content = mcContent mc - ci@ChatItem {formattedText} <- saveRcvChatItem user (CDDirectRcv ct) msg msgMeta (CIRcvMsgContent content) + let (ExtMsgContent content fileInvitation_) = mcExtMsgContent mc + ciFile_ <- processFileInvitation fileInvitation_ $ + \fi chSize -> withStore $ \st -> createRcvFileTransfer st userId ct fi chSize + ci@ChatItem {formattedText} <- saveRcvChatItem user (CDDirectRcv ct) msg msgMeta (CIRcvMsgContent content) ciFile_ toView . CRNewChatItem $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci checkIntegrity msgMeta $ toView . CRMsgIntegrityError showMsgToast (c <> "> ") content formattedText setActive $ ActiveC c + processFileInvitation :: Maybe FileInvitation -> (FileInvitation -> Integer -> m RcvFileTransfer) -> m (Maybe (CIFile 'MDRcv)) + processFileInvitation fileInvitation_ createRcvFileTransferF = case fileInvitation_ of + Nothing -> pure Nothing + Just fileInvitation@FileInvitation {fileName, fileSize} -> do + chSize <- asks $ fileChunkSize . config + RcvFileTransfer {fileId} <- createRcvFileTransferF fileInvitation chSize + let ciFile = CIFile {fileId, fileName, fileSize, filePath = Nothing, fileStatus = CIFSRcvInvitation} + pure $ Just ciFile + messageUpdate :: Contact -> SharedMsgId -> MsgContent -> RcvMessage -> MsgMeta -> m () messageUpdate ct@Contact {contactId} sharedMsgId mc RcvMessage {msgId} msgMeta = do CChatItem msgDir ChatItem {meta = CIMeta {itemId}} <- withStore $ \st -> getDirectChatItemBySharedMsgId st userId contactId sharedMsgId @@ -1181,8 +1239,10 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage newGroupContentMessage :: GroupInfo -> GroupMember -> MsgContainer -> RcvMessage -> MsgMeta -> m () newGroupContentMessage gInfo m@GroupMember {localDisplayName = c} mc msg msgMeta = do - let content = mcContent mc - ci@ChatItem {formattedText} <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvMsgContent content) + let (ExtMsgContent content fileInvitation_) = mcExtMsgContent mc + ciFile_ <- processFileInvitation fileInvitation_ $ + \fi chSize -> withStore $ \st -> createRcvGroupFileTransfer st userId m fi chSize + ci@ChatItem {formattedText} <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvMsgContent content) ciFile_ groupMsgToView gInfo ci msgMeta let g = groupName' gInfo showMsgToast ("#" <> g <> " " <> c <> "> ") content formattedText @@ -1212,24 +1272,26 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage else messageError "x.msg.del: group member attempted to delete a message of another member" (SMDSnd, _) -> messageError "x.msg.del: group member attempted invalid message delete" - processFileInvitation :: Contact -> FileInvitation -> RcvMessage -> MsgMeta -> m () - processFileInvitation ct@Contact {localDisplayName = c} fInv msg msgMeta = do + -- TODO remove once XFile is discontinued + processFileInvitation' :: Contact -> FileInvitation -> RcvMessage -> MsgMeta -> m () + processFileInvitation' ct@Contact {localDisplayName = c} fInv@FileInvitation {fileName, fileSize} msg msgMeta = do -- TODO chunk size has to be sent as part of invitation chSize <- asks $ fileChunkSize . config - ft@RcvFileTransfer {fileId} <- withStore $ \st -> createRcvFileTransfer st userId ct fInv chSize - ci <- saveRcvChatItem user (CDDirectRcv ct) msg msgMeta (CIRcvFileInvitation ft) - withStore $ \st -> updateFileTransferChatItemId st fileId $ chatItemId' ci + RcvFileTransfer {fileId} <- withStore $ \st -> createRcvFileTransfer st userId ct fInv chSize + let ciFile = Just $ CIFile {fileId, fileName, fileSize, filePath = Nothing, fileStatus = CIFSRcvInvitation} + ci <- saveRcvChatItem user (CDDirectRcv ct) msg msgMeta (CIRcvMsgContent $ MCText "") ciFile toView . CRNewChatItem $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci checkIntegrity msgMeta $ toView . CRMsgIntegrityError showToast (c <> "> ") "wants to send a file" setActive $ ActiveC c - processGroupFileInvitation :: GroupInfo -> GroupMember -> FileInvitation -> RcvMessage -> MsgMeta -> m () - processGroupFileInvitation gInfo m@GroupMember {localDisplayName = c} fInv msg msgMeta = do + -- TODO remove once XFile is discontinued + processGroupFileInvitation' :: GroupInfo -> GroupMember -> FileInvitation -> RcvMessage -> MsgMeta -> m () + processGroupFileInvitation' gInfo m@GroupMember {localDisplayName = c} fInv@FileInvitation {fileName, fileSize} msg msgMeta = do chSize <- asks $ fileChunkSize . config - ft@RcvFileTransfer {fileId} <- withStore $ \st -> createRcvGroupFileTransfer st userId m fInv chSize - ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvFileInvitation ft) - withStore $ \st -> updateFileTransferChatItemId st fileId $ chatItemId' ci + RcvFileTransfer {fileId} <- withStore $ \st -> createRcvGroupFileTransfer st userId m fInv chSize + let ciFile = Just $ CIFile {fileId, fileName, fileSize, filePath = Nothing, fileStatus = CIFSRcvInvitation} + ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvMsgContent $ MCText "") ciFile groupMsgToView gInfo ci msgMeta let g = groupName' gInfo showToast ("#" <> g <> " " <> c <> "> ") "wants to send a file" @@ -1610,35 +1672,27 @@ saveRcvMSG Connection {connId} connOrGroupId agentMsgMeta msgBody = do rcvMsgDelivery = RcvMsgDelivery {connId, agentMsgId, agentMsgMeta} withStore $ \st -> createNewMessageAndRcvMsgDelivery st connOrGroupId newMsg sharedMsgId_ rcvMsgDelivery -sendDirectChatItem :: ChatMonad m => User -> Contact -> ChatMsgEvent -> CIContent 'MDSnd -> Maybe (CIQuote 'CTDirect) -> m (ChatItem 'CTDirect 'MDSnd) -sendDirectChatItem user ct chatMsgEvent ciContent quotedItem = do - msg <- sendDirectContactMessage ct chatMsgEvent - saveSndChatItem user (CDDirectSnd ct) msg ciContent quotedItem - -sendGroupChatItem :: ChatMonad m => User -> Group -> ChatMsgEvent -> CIContent 'MDSnd -> Maybe (CIQuote 'CTGroup) -> m (ChatItem 'CTGroup 'MDSnd) -sendGroupChatItem user (Group g ms) chatMsgEvent ciContent quotedItem = do - msg <- sendGroupMessage g ms chatMsgEvent - saveSndChatItem user (CDGroupSnd g) msg ciContent quotedItem - -saveSndChatItem :: ChatMonad m => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIQuote c) -> m (ChatItem c 'MDSnd) -saveSndChatItem user cd msg@SndMessage {sharedMsgId} content quotedItem = do +saveSndChatItem :: ChatMonad m => User -> ChatDirection c 'MDSnd -> SndMessage -> CIContent 'MDSnd -> Maybe (CIFile 'MDSnd) -> Maybe (CIQuote c) -> m (ChatItem c 'MDSnd) +saveSndChatItem user cd msg@SndMessage {sharedMsgId} content ciFile quotedItem = do createdAt <- liftIO getCurrentTime ciId <- withStore $ \st -> createNewSndChatItem st user cd msg content quotedItem createdAt - liftIO $ mkChatItem cd ciId content quotedItem (Just sharedMsgId) createdAt createdAt + forM_ ciFile $ \CIFile {fileId} -> withStore $ \st -> updateFileTransferChatItemId st fileId ciId + liftIO $ mkChatItem cd ciId content ciFile quotedItem (Just sharedMsgId) createdAt createdAt -saveRcvChatItem :: ChatMonad m => User -> ChatDirection c 'MDRcv -> RcvMessage -> MsgMeta -> CIContent 'MDRcv -> m (ChatItem c 'MDRcv) -saveRcvChatItem user cd msg@RcvMessage {sharedMsgId_} MsgMeta {broker = (_, brokerTs)} content = do +saveRcvChatItem :: ChatMonad m => User -> ChatDirection c 'MDRcv -> RcvMessage -> MsgMeta -> CIContent 'MDRcv -> Maybe (CIFile 'MDRcv) -> m (ChatItem c 'MDRcv) +saveRcvChatItem user cd msg@RcvMessage {sharedMsgId_} MsgMeta {broker = (_, brokerTs)} content ciFile = do createdAt <- liftIO getCurrentTime - (ciId, quotedItem) <- withStore $ \st -> createNewRcvChatItem st user cd msg content brokerTs createdAt -- createNewChatItem st user cd $ mkNewChatItem content msg brokerTs createdAt - liftIO $ mkChatItem cd ciId content quotedItem sharedMsgId_ brokerTs createdAt + (ciId, quotedItem) <- withStore $ \st -> createNewRcvChatItem st user cd msg content brokerTs createdAt + forM_ ciFile $ \CIFile {fileId} -> withStore $ \st -> updateFileTransferChatItemId st fileId ciId + liftIO $ mkChatItem cd ciId content ciFile quotedItem sharedMsgId_ brokerTs createdAt -mkChatItem :: MsgDirectionI d => ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIQuote c) -> Maybe SharedMsgId -> ChatItemTs -> UTCTime -> IO (ChatItem c d) -mkChatItem cd ciId content quotedItem sharedMsgId itemTs createdAt = do +mkChatItem :: MsgDirectionI d => ChatDirection c d -> ChatItemId -> CIContent d -> Maybe (CIFile d) -> Maybe (CIQuote c) -> Maybe SharedMsgId -> ChatItemTs -> UTCTime -> IO (ChatItem c d) +mkChatItem cd ciId content file quotedItem sharedMsgId itemTs createdAt = do tz <- getCurrentTimeZone currentTs <- liftIO getCurrentTime let itemText = ciContentToText content meta = mkCIMeta ciId content itemText ciStatusNew sharedMsgId False False tz currentTs itemTs createdAt - pure ChatItem {chatDir = toCIDirection cd, meta, content, formattedText = parseMaybeMarkdownList itemText, quotedItem, file = Nothing} + pure ChatItem {chatDir = toCIDirection cd, meta, content, formattedText = parseMaybeMarkdownList itemText, quotedItem, file} allowAgentConnection :: ChatMonad m => Connection -> ConfirmationId -> ChatMsgEvent -> m () allowAgentConnection conn confId msg = do @@ -1755,8 +1809,8 @@ chatCommandP = <|> "/_get chats" $> APIGetChats <|> "/_get chat " *> (APIGetChat <$> chatTypeP <*> A.decimal <* A.space <*> chatPaginationP) <|> "/_get items count=" *> (APIGetChatItems <$> A.decimal) - <|> "/_send " *> (APISendMessage <$> chatTypeP <*> A.decimal <*> optional filePathTagged <* A.space <*> msgContentP) - <|> "/_send_quote " *> (APISendMessageQuote <$> chatTypeP <*> A.decimal <* A.space <*> A.decimal <*> optional filePathTagged <* A.space <*> msgContentP) + <|> "/_send " *> (APISendMessage <$> chatTypeP <*> A.decimal <*> optional filePathTagged <*> optional quotedItemIdTagged <* A.space <*> msgContentP) + <|> "/_send_quote " *> (APISendMessageQuote <$> chatTypeP <*> A.decimal <* A.space <*> A.decimal <* A.space <*> msgContentP) <|> "/_update item " *> (APIUpdateChatItem <$> chatTypeP <*> A.decimal <* A.space <*> A.decimal <* A.space <*> msgContentP) <|> "/_delete item " *> (APIDeleteChatItem <$> chatTypeP <*> A.decimal <* A.space <*> A.decimal <* A.space <*> ciDeleteMode) <|> "/_read chat " *> (APIChatRead <$> chatTypeP <*> A.decimal <* A.space <*> ((,) <$> ("from=" *> A.decimal) <* A.space <*> ("to=" *> A.decimal))) @@ -1853,6 +1907,7 @@ chatCommandP = pure $ if B.null n then name else safeDecodeUtf8 n filePath = T.unpack . safeDecodeUtf8 <$> A.takeByteString filePathTagged = " file " *> (T.unpack . safeDecodeUtf8 <$> A.takeTill (== ' ')) + quotedItemIdTagged = " quoted " *> A.decimal memberRole = (" owner" $> GROwner) <|> (" admin" $> GRAdmin) diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index 6e2419f3a9..1842b632c9 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -94,8 +94,8 @@ data ChatCommand | APIGetChats | APIGetChat ChatType Int64 ChatPagination | APIGetChatItems Int - | APISendMessage ChatType Int64 (Maybe FilePath) MsgContent - | APISendMessageQuote ChatType Int64 ChatItemId (Maybe FilePath) MsgContent + | APISendMessage ChatType Int64 (Maybe FilePath) (Maybe ChatItemId) MsgContent + | APISendMessageQuote ChatType Int64 ChatItemId MsgContent -- TODO discontinue | APIUpdateChatItem ChatType Int64 ChatItemId MsgContent | APIDeleteChatItem ChatType Int64 ChatItemId CIDeleteMode | APIChatRead ChatType Int64 (ChatItemId, ChatItemId) diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 7ebdca07f0..b2bc8d2218 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -20,7 +20,6 @@ import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Lazy.Char8 as LB import Data.Int (Int64) import Data.Text (Text) -import qualified Data.Text as T import Data.Text.Encoding (decodeLatin1, encodeUtf8) import Data.Time.Clock (UTCTime, diffUTCTime, nominalDay) import Data.Time.LocalTime (TimeZone, ZonedTime, utcToZonedTime) @@ -80,11 +79,11 @@ data ChatItem (c :: ChatType) (d :: MsgDirection) = ChatItem content :: CIContent d, formattedText :: Maybe MarkdownList, quotedItem :: Maybe (CIQuote c), - file :: Maybe CIFile + file :: Maybe (CIFile d) } deriving (Show, Generic) -instance ToJSON (ChatItem c d) where +instance MsgDirectionI d => ToJSON (ChatItem c d) where toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True} toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True} @@ -197,7 +196,7 @@ instance ToJSON AChatItem where data JSONAnyChatItem c d = JSONAnyChatItem {chatInfo :: ChatInfo c, chatItem :: ChatItem c d} deriving (Generic) -instance ToJSON (JSONAnyChatItem c d) where +instance MsgDirectionI d => ToJSON (JSONAnyChatItem c d) where toJSON = J.genericToJSON J.defaultOptions toEncoding = J.genericToEncoding J.defaultOptions @@ -266,16 +265,63 @@ quoteMsgDirection = \case CIQGroupSnd -> MDSnd CIQGroupRcv _ -> MDRcv -data CIFile = CIFile - { file :: FilePath, -- local file path - loaded :: Bool +data CIFile (d :: MsgDirection) = CIFile + { fileId :: Int64, + fileName :: String, + fileSize :: Integer, + filePath :: Maybe FilePath, -- local file path + fileStatus :: CIFileStatus d } deriving (Show, Generic) -instance ToJSON CIFile where +instance MsgDirectionI d => ToJSON (CIFile d) where toJSON = J.genericToJSON J.defaultOptions {J.omitNothingFields = True} toEncoding = J.genericToEncoding J.defaultOptions {J.omitNothingFields = True} +data CIFileStatus (d :: MsgDirection) where + CIFSSndStored :: CIFileStatus 'MDSnd + CIFSSndCancelled :: CIFileStatus 'MDSnd + CIFSRcvInvitation :: CIFileStatus 'MDRcv + CIFSRcvTransfer :: CIFileStatus 'MDRcv + CIFSRcvComplete :: CIFileStatus 'MDRcv + CIFSRcvCancelled :: CIFileStatus 'MDRcv + +deriving instance Show (CIFileStatus d) + +instance MsgDirectionI d => ToJSON (CIFileStatus d) where + toJSON = strToJSON + toEncoding = strToJEncoding + +instance MsgDirectionI d => ToField (CIFileStatus d) where toField = toField . decodeLatin1 . strEncode + +instance FromField ACIFileStatus where fromField = fromTextField_ $ eitherToMaybe . strDecode . encodeUtf8 + +data ACIFileStatus = forall d. MsgDirectionI d => AFS (SMsgDirection d) (CIFileStatus d) + +deriving instance Show ACIFileStatus + +instance MsgDirectionI d => StrEncoding (CIFileStatus d) where + strEncode = \case + CIFSSndStored -> "snd_stored" + CIFSSndCancelled -> "snd_cancelled" + CIFSRcvInvitation -> "rcv_invitation" + CIFSRcvTransfer -> "rcv_transfer" + CIFSRcvComplete -> "rcv_complete" + CIFSRcvCancelled -> "rcv_cancelled" + strP = (\(AFS _ st) -> checkDirection st) <$?> strP + +instance StrEncoding ACIFileStatus where + strEncode (AFS _ s) = strEncode s + strP = + A.takeTill (== ' ') >>= \case + "snd_stored" -> pure $ AFS SMDSnd CIFSSndStored + "snd_cancelled" -> pure $ AFS SMDSnd CIFSSndCancelled + "rcv_invitation" -> pure $ AFS SMDRcv CIFSRcvInvitation + "rcv_transfer" -> pure $ AFS SMDRcv CIFSRcvTransfer + "rcv_complete" -> pure $ AFS SMDRcv CIFSRcvComplete + "rcv_cancelled" -> pure $ AFS SMDRcv CIFSRcvCancelled + _ -> fail "bad file status" + data CIStatus (d :: MsgDirection) where CISSndNew :: CIStatus 'MDSnd CISSndSent :: CIStatus 'MDSnd @@ -377,8 +423,6 @@ data CIContent (d :: MsgDirection) where CIRcvMsgContent :: MsgContent -> CIContent 'MDRcv CISndDeleted :: CIDeleteMode -> CIContent 'MDSnd CIRcvDeleted :: CIDeleteMode -> CIContent 'MDRcv - CISndFileInvitation :: FileTransferId -> FilePath -> CIContent 'MDSnd - CIRcvFileInvitation :: RcvFileTransfer -> CIContent 'MDRcv deriving instance Show (CIContent d) @@ -388,8 +432,6 @@ ciContentToText = \case CIRcvMsgContent mc -> msgContentText mc CISndDeleted cidm -> ciDeleteModeToText cidm CIRcvDeleted cidm -> ciDeleteModeToText cidm - CISndFileInvitation fId fPath -> "you sent file #" <> T.pack (show fId) <> ": " <> T.pack fPath - CIRcvFileInvitation RcvFileTransfer {fileInvitation = FileInvitation {fileName}} -> "file " <> T.pack fileName msgDirToDeletedContent_ :: SMsgDirection d -> CIDeleteMode -> CIContent d msgDirToDeletedContent_ msgDir mode = case msgDir of @@ -422,8 +464,6 @@ data JSONCIContent | JCIRcvMsgContent {msgContent :: MsgContent} | JCISndDeleted {deleteMode :: CIDeleteMode} | JCIRcvDeleted {deleteMode :: CIDeleteMode} - | JCISndFileInvitation {fileId :: FileTransferId, filePath :: FilePath} - | JCIRcvFileInvitation {rcvFileTransfer :: RcvFileTransfer} deriving (Generic) instance FromJSON JSONCIContent where @@ -439,8 +479,6 @@ jsonCIContent = \case CIRcvMsgContent mc -> JCIRcvMsgContent mc CISndDeleted cidm -> JCISndDeleted cidm CIRcvDeleted cidm -> JCIRcvDeleted cidm - CISndFileInvitation fId fPath -> JCISndFileInvitation fId fPath - CIRcvFileInvitation ft -> JCIRcvFileInvitation ft aciContentJSON :: JSONCIContent -> ACIContent aciContentJSON = \case @@ -448,8 +486,6 @@ aciContentJSON = \case JCIRcvMsgContent mc -> ACIContent SMDRcv $ CIRcvMsgContent mc JCISndDeleted cidm -> ACIContent SMDSnd $ CISndDeleted cidm JCIRcvDeleted cidm -> ACIContent SMDRcv $ CIRcvDeleted cidm - JCISndFileInvitation fId fPath -> ACIContent SMDSnd $ CISndFileInvitation fId fPath - JCIRcvFileInvitation ft -> ACIContent SMDRcv $ CIRcvFileInvitation ft -- platform independent data DBJSONCIContent @@ -457,8 +493,6 @@ data DBJSONCIContent | DBJCIRcvMsgContent {msgContent :: MsgContent} | DBJCISndDeleted {deleteMode :: CIDeleteMode} | DBJCIRcvDeleted {deleteMode :: CIDeleteMode} - | DBJCISndFileInvitation {fileId :: FileTransferId, filePath :: FilePath} - | DBJCIRcvFileInvitation {rcvFileTransfer :: RcvFileTransfer} deriving (Generic) instance FromJSON DBJSONCIContent where @@ -474,8 +508,6 @@ dbJsonCIContent = \case CIRcvMsgContent mc -> DBJCIRcvMsgContent mc CISndDeleted cidm -> DBJCISndDeleted cidm CIRcvDeleted cidm -> DBJCIRcvDeleted cidm - CISndFileInvitation fId fPath -> DBJCISndFileInvitation fId fPath - CIRcvFileInvitation ft -> DBJCIRcvFileInvitation ft aciContentDBJSON :: DBJSONCIContent -> ACIContent aciContentDBJSON = \case @@ -483,8 +515,6 @@ aciContentDBJSON = \case DBJCIRcvMsgContent mc -> ACIContent SMDRcv $ CIRcvMsgContent mc DBJCISndDeleted cidm -> ACIContent SMDSnd $ CISndDeleted cidm DBJCIRcvDeleted cidm -> ACIContent SMDRcv $ CIRcvDeleted cidm - DBJCISndFileInvitation fId fPath -> ACIContent SMDSnd $ CISndFileInvitation fId fPath - DBJCIRcvFileInvitation ft -> ACIContent SMDRcv $ CIRcvFileInvitation ft data SChatType (c :: ChatType) where SCTDirect :: SChatType 'CTDirect diff --git a/src/Simplex/Chat/Migrations/M20220404_files_cancelled.hs b/src/Simplex/Chat/Migrations/M20220404_files_cancelled.hs deleted file mode 100644 index c1187a7ec3..0000000000 --- a/src/Simplex/Chat/Migrations/M20220404_files_cancelled.hs +++ /dev/null @@ -1,12 +0,0 @@ -{-# LANGUAGE QuasiQuotes #-} - -module Simplex.Chat.Migrations.M20220404_files_cancelled where - -import Database.SQLite.Simple (Query) -import Database.SQLite.Simple.QQ (sql) - -m20220404_files_cancelled :: Query -m20220404_files_cancelled = - [sql| -ALTER TABLE files ADD COLUMN cancelled INTEGER; -- 1 for cancelled -|] diff --git a/src/Simplex/Chat/Migrations/M20220404_files_status_fields.hs b/src/Simplex/Chat/Migrations/M20220404_files_status_fields.hs new file mode 100644 index 0000000000..40623a3be6 --- /dev/null +++ b/src/Simplex/Chat/Migrations/M20220404_files_status_fields.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Simplex.Chat.Migrations.M20220404_files_status_fields where + +import Database.SQLite.Simple (Query) +import Database.SQLite.Simple.QQ (sql) + +m20220404_files_status_fields :: Query +m20220404_files_status_fields = + [sql| +ALTER TABLE files ADD COLUMN cancelled INTEGER; -- 1 for cancelled +ALTER TABLE files ADD COLUMN ci_file_status TEXT; -- CIFileStatus + +DELETE FROM chat_items +WHERE chat_item_id IN ( + SELECT chat_item_id + FROM files +); +|] diff --git a/src/Simplex/Chat/Migrations/chat_schema.sql b/src/Simplex/Chat/Migrations/chat_schema.sql index afe9c16eaa..6e1b0ff732 100644 --- a/src/Simplex/Chat/Migrations/chat_schema.sql +++ b/src/Simplex/Chat/Migrations/chat_schema.sql @@ -134,7 +134,7 @@ CREATE TABLE files ( chunk_size INTEGER NOT NULL, created_at TEXT NOT NULL DEFAULT (datetime('now')), user_id INTEGER NOT NULL REFERENCES users ON DELETE CASCADE -, chat_item_id INTEGER DEFAULT NULL REFERENCES chat_items ON DELETE CASCADE, updated_at TEXT CHECK (updated_at NOT NULL), cancelled INTEGER); +, chat_item_id INTEGER DEFAULT NULL REFERENCES chat_items ON DELETE CASCADE, updated_at TEXT CHECK (updated_at NOT NULL), cancelled INTEGER, ci_file_status TEXT); CREATE TABLE snd_files ( file_id INTEGER NOT NULL REFERENCES files ON DELETE CASCADE, connection_id INTEGER NOT NULL REFERENCES connections ON DELETE CASCADE, diff --git a/src/Simplex/Chat/Protocol.hs b/src/Simplex/Chat/Protocol.hs index 3edebc93a8..b52786fe86 100644 --- a/src/Simplex/Chat/Protocol.hs +++ b/src/Simplex/Chat/Protocol.hs @@ -112,7 +112,7 @@ data ChatMsgEvent | XMsgUpdate SharedMsgId MsgContent | XMsgDel SharedMsgId | XMsgDeleted - | XFile FileInvitation + | XFile FileInvitation -- TODO discontinue | XFileAcpt String -- old file protocol | XFileAcptInv SharedMsgId ConnReqInvitation String -- new file protocol | XInfo Profile @@ -176,11 +176,11 @@ data MsgContainer | MCForward ExtMsgContent deriving (Eq, Show) -mcContent :: MsgContainer -> MsgContent -mcContent = \case - MCSimple (ExtMsgContent c _) -> c - MCQuote _ (ExtMsgContent c _) -> c - MCForward (ExtMsgContent c _) -> c +mcExtMsgContent :: MsgContainer -> ExtMsgContent +mcExtMsgContent = \case + MCSimple c -> c + MCQuote _ c -> c + MCForward c -> c data LinkPreview = LinkPreview {uri :: Text, title :: Text, description :: Text, image :: ImageData} deriving (Eq, Show, Generic) diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index e63edd0a6a..19a7cfefb3 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -95,6 +95,7 @@ module Simplex.Chat.Store createSndGroupFileTransferV2, createSndGroupFileTransferV2Connection, updateFileCancelled, + updateCIFileStatus, getSharedMsgIdByFileId, getFileIdBySharedMsgId, getGroupFileIdBySharedMsgId, @@ -188,7 +189,7 @@ import Simplex.Chat.Migrations.M20220301_smp_servers import Simplex.Chat.Migrations.M20220302_profile_images import Simplex.Chat.Migrations.M20220304_msg_quotes import Simplex.Chat.Migrations.M20220321_chat_item_edited -import Simplex.Chat.Migrations.M20220404_files_cancelled +import Simplex.Chat.Migrations.M20220404_files_status_fields import Simplex.Chat.Protocol import Simplex.Chat.Types import Simplex.Chat.Util (eitherToMaybe) @@ -213,7 +214,7 @@ schemaMigrations = ("20220302_profile_images", m20220302_profile_images), ("20220304_msg_quotes", m20220304_msg_quotes), ("20220321_chat_item_edited", m20220321_chat_item_edited), - ("20220404_files_cancelled", m20220404_files_cancelled) + ("20220404_files_status_fields", m20220404_files_status_fields) ] -- | The list of migrations in ascending order by date @@ -1783,14 +1784,14 @@ getViaGroupContact st User {userId} GroupMember {groupMemberId} = in Just Contact {contactId, localDisplayName, profile, activeConn, viaGroup, createdAt} toContact' _ = Nothing -createSndFileTransfer :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> FilePath -> FileInvitation -> ConnId -> Integer -> m SndFileTransfer -createSndFileTransfer st userId Contact {contactId, localDisplayName = recipientDisplayName} filePath FileInvitation {fileName, fileSize} acId chunkSize = +createSndFileTransfer :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> FilePath -> FileInvitation -> ConnId -> Integer -> m Int64 +createSndFileTransfer st userId Contact {contactId} filePath FileInvitation {fileName, fileSize} acId chunkSize = liftIO . withTransaction st $ \db -> do currentTs <- getCurrentTime DB.execute db - "INSERT INTO files (user_id, contact_id, file_name, file_path, file_size, chunk_size, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)" - (userId, contactId, fileName, filePath, fileSize, chunkSize, currentTs, currentTs) + "INSERT INTO files (user_id, contact_id, file_name, file_path, file_size, chunk_size, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)" + (userId, contactId, fileName, filePath, fileSize, chunkSize, CIFSSndStored, currentTs, currentTs) fileId <- insertedRowId db Connection {connId} <- createSndFileConnection_ db userId fileId acId let fileStatus = FSNew @@ -1798,7 +1799,7 @@ createSndFileTransfer st userId Contact {contactId, localDisplayName = recipient db "INSERT INTO snd_files (file_id, file_status, connection_id, created_at, updated_at) VALUES (?,?,?,?,?)" (fileId, fileStatus, connId, currentTs, currentTs) - pure SndFileTransfer {fileId, fileName, filePath, fileSize, chunkSize, recipientDisplayName, connId, fileStatus, agentConnId = AgentConnId acId} + pure fileId createSndFileTransferV2 :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> FilePath -> FileInvitation -> Integer -> m Int64 createSndFileTransferV2 st userId Contact {contactId} filePath FileInvitation {fileName, fileSize} chunkSize = @@ -1806,8 +1807,8 @@ createSndFileTransferV2 st userId Contact {contactId} filePath FileInvitation {f currentTs <- getCurrentTime DB.execute db - "INSERT INTO files (user_id, contact_id, file_name, file_path, file_size, chunk_size, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)" - (userId, contactId, fileName, filePath, fileSize, chunkSize, currentTs, currentTs) + "INSERT INTO files (user_id, contact_id, file_name, file_path, file_size, chunk_size, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)" + (userId, contactId, fileName, filePath, fileSize, chunkSize, CIFSSndStored, currentTs, currentTs) insertedRowId db createSndFileTransferV2Connection :: MonadUnliftIO m => SQLiteStore -> UserId -> Int64 -> ConnId -> m () @@ -1827,8 +1828,8 @@ createSndGroupFileTransfer st userId GroupInfo {groupId} ms filePath fileSize ch currentTs <- getCurrentTime DB.execute db - "INSERT INTO files (user_id, group_id, file_name, file_path, file_size, chunk_size, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)" - (userId, groupId, fileName, filePath, fileSize, chunkSize, currentTs, currentTs) + "INSERT INTO files (user_id, group_id, file_name, file_path, file_size, chunk_size, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)" + (userId, groupId, fileName, filePath, fileSize, chunkSize, CIFSSndStored, currentTs, currentTs) fileId <- insertedRowId db forM_ ms $ \(GroupMember {groupMemberId}, agentConnId, _) -> do Connection {connId} <- createSndFileConnection_ db userId fileId agentConnId @@ -1844,8 +1845,8 @@ createSndGroupFileTransferV2 st userId GroupInfo {groupId} filePath FileInvitati currentTs <- getCurrentTime DB.execute db - "INSERT INTO files (user_id, group_id, file_name, file_path, file_size, chunk_size, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)" - (userId, groupId, fileName, filePath, fileSize, chunkSize, currentTs, currentTs) + "INSERT INTO files (user_id, group_id, file_name, file_path, file_size, chunk_size, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?,?)" + (userId, groupId, fileName, filePath, fileSize, chunkSize, CIFSSndStored, currentTs, currentTs) insertedRowId db createSndGroupFileTransferV2Connection :: MonadUnliftIO m => SQLiteStore -> UserId -> Int64 -> ConnId -> GroupMember -> m () @@ -1864,6 +1865,12 @@ updateFileCancelled st userId fileId = currentTs <- getCurrentTime DB.execute db "UPDATE files SET cancelled = 1, updated_at = ? WHERE user_id = ? AND file_id = ?" (currentTs, userId, fileId) +updateCIFileStatus :: MsgDirectionI d => MonadUnliftIO m => SQLiteStore -> UserId -> Int64 -> CIFileStatus d -> m () +updateCIFileStatus st userId fileId ciFileStatus = + liftIO . withTransaction st $ \db -> do + currentTs <- getCurrentTime + DB.execute db "UPDATE files SET ci_file_status = ?, updated_at = ? WHERE user_id = ? AND file_id = ?" (ciFileStatus, currentTs, userId, fileId) + getSharedMsgIdByFileId :: StoreMonad m => SQLiteStore -> UserId -> Int64 -> m SharedMsgId getSharedMsgIdByFileId st userId fileId = liftIOEither . withTransaction st $ \db -> @@ -1975,8 +1982,8 @@ createRcvFileTransfer st userId Contact {contactId, localDisplayName = c} f@File currentTs <- getCurrentTime DB.execute db - "INSERT INTO files (user_id, contact_id, file_name, file_size, chunk_size, created_at, updated_at) VALUES (?,?,?,?,?,?,?)" - (userId, contactId, fileName, fileSize, chunkSize, currentTs, currentTs) + "INSERT INTO files (user_id, contact_id, file_name, file_size, chunk_size, ci_file_status, created_at, updated_at) VALUES (?,?,?,?,?,?,?,?)" + (userId, contactId, fileName, fileSize, chunkSize, CIFSRcvInvitation, currentTs, currentTs) fileId <- insertedRowId db DB.execute db @@ -2052,8 +2059,8 @@ acceptRcvFileTransfer st userId fileId agentConnId filePath = currentTs <- getCurrentTime DB.execute db - "UPDATE files SET file_path = ?, updated_at = ? WHERE user_id = ? AND file_id = ?" - (filePath, currentTs, userId, fileId) + "UPDATE files SET file_path = ?, ci_file_status = ?, updated_at = ? WHERE user_id = ? AND file_id = ?" + (filePath, CIFSRcvTransfer, currentTs, userId, fileId) DB.execute db "UPDATE rcv_files SET file_status = ?, updated_at = ? WHERE file_id = ?" @@ -2512,6 +2519,8 @@ getDirectChatPreviews_ db User {userId} = do COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), -- ChatItem i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, + -- CIFile + f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status, -- DirectQuote ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent FROM contacts ct @@ -2525,6 +2534,7 @@ getDirectChatPreviews_ db User {userId} = do ) MaxIds ON MaxIds.contact_id = ct.contact_id LEFT JOIN chat_items i ON i.contact_id = MaxIds.contact_id AND i.chat_item_id = MaxIds.MaxId + LEFT JOIN files f ON f.chat_item_id = i.chat_item_id LEFT JOIN ( SELECT contact_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread FROM chat_items @@ -2574,6 +2584,8 @@ getGroupChatPreviews_ db User {userId, userContactId} = do COALESCE(ChatStats.UnreadCount, 0), COALESCE(ChatStats.MinUnread, 0), -- ChatItem i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, + -- CIFile + f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status, -- Maybe GroupMember - sender m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, m.invited_by, m.local_display_name, m.contact_id, @@ -2596,6 +2608,7 @@ getGroupChatPreviews_ db User {userId, userContactId} = do ) MaxIds ON MaxIds.group_id = g.group_id LEFT JOIN chat_items i ON i.group_id = MaxIds.group_id AND i.chat_item_id = MaxIds.MaxId + LEFT JOIN files f ON f.chat_item_id = i.chat_item_id LEFT JOIN ( SELECT group_id, COUNT(1) AS UnreadCount, MIN(chat_item_id) AS MinUnread FROM chat_items @@ -2667,9 +2680,12 @@ getDirectChatLast_ db User {userId} contactId count = do SELECT -- ChatItem i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, + -- CIFile + f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status, -- DirectQuote ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent FROM chat_items i + LEFT JOIN files f ON f.chat_item_id = i.chat_item_id LEFT JOIN chat_items ri ON i.quoted_shared_msg_id = ri.shared_msg_id WHERE i.user_id = ? AND i.contact_id = ? AND i.item_deleted != 1 ORDER BY i.chat_item_id DESC @@ -2695,9 +2711,12 @@ getDirectChatAfter_ db User {userId} contactId afterChatItemId count = do SELECT -- ChatItem i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, + -- CIFile + f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status, -- DirectQuote ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent FROM chat_items i + LEFT JOIN files f ON f.chat_item_id = i.chat_item_id LEFT JOIN chat_items ri ON i.quoted_shared_msg_id = ri.shared_msg_id WHERE i.user_id = ? AND i.contact_id = ? AND i.chat_item_id > ? AND i.item_deleted != 1 ORDER BY i.chat_item_id ASC @@ -2723,9 +2742,12 @@ getDirectChatBefore_ db User {userId} contactId beforeChatItemId count = do SELECT -- ChatItem i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, + -- CIFile + f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status, -- DirectQuote ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent FROM chat_items i + LEFT JOIN files f ON f.chat_item_id = i.chat_item_id LEFT JOIN chat_items ri ON i.quoted_shared_msg_id = ri.shared_msg_id WHERE i.user_id = ? AND i.contact_id = ? AND i.chat_item_id < ? AND i.item_deleted != 1 ORDER BY i.chat_item_id DESC @@ -2823,6 +2845,8 @@ getGroupChatLast_ db user@User {userId, userContactId} groupId count = do SELECT -- ChatItem i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, + -- CIFile + f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status, -- GroupMember m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, m.invited_by, m.local_display_name, m.contact_id, @@ -2834,6 +2858,7 @@ getGroupChatLast_ db user@User {userId, userContactId} groupId count = do rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id, rp.display_name, rp.full_name, rp.image FROM chat_items i + LEFT JOIN files f ON f.chat_item_id = i.chat_item_id LEFT JOIN group_members m ON m.group_member_id = i.group_member_id LEFT JOIN contact_profiles p ON p.contact_profile_id = m.contact_profile_id LEFT JOIN chat_items ri ON i.quoted_shared_msg_id = ri.shared_msg_id @@ -2863,6 +2888,8 @@ getGroupChatAfter_ db user@User {userId, userContactId} groupId afterChatItemId SELECT -- ChatItem i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, + -- CIFile + f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status, -- GroupMember m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, m.invited_by, m.local_display_name, m.contact_id, @@ -2874,6 +2901,7 @@ getGroupChatAfter_ db user@User {userId, userContactId} groupId afterChatItemId rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id, rp.display_name, rp.full_name, rp.image FROM chat_items i + LEFT JOIN files f ON f.chat_item_id = i.chat_item_id LEFT JOIN group_members m ON m.group_member_id = i.group_member_id LEFT JOIN contact_profiles p ON p.contact_profile_id = m.contact_profile_id LEFT JOIN chat_items ri ON i.quoted_shared_msg_id = ri.shared_msg_id @@ -2903,6 +2931,8 @@ getGroupChatBefore_ db user@User {userId, userContactId} groupId beforeChatItemI SELECT -- ChatItem i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, + -- CIFile + f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status, -- GroupMember m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, m.invited_by, m.local_display_name, m.contact_id, @@ -2914,6 +2944,7 @@ getGroupChatBefore_ db user@User {userId, userContactId} groupId beforeChatItemI rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id, rp.display_name, rp.full_name, rp.image FROM chat_items i + LEFT JOIN files f ON f.chat_item_id = i.chat_item_id LEFT JOIN group_members m ON m.group_member_id = i.group_member_id LEFT JOIN contact_profiles p ON p.contact_profile_id = m.contact_profile_id LEFT JOIN chat_items ri ON i.quoted_shared_msg_id = ri.shared_msg_id @@ -3138,9 +3169,12 @@ getDirectChatItem_ db userId contactId itemId = do SELECT -- ChatItem i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, + -- CIFile + f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status, -- DirectQuote ri.chat_item_id, i.quoted_shared_msg_id, i.quoted_sent_at, i.quoted_content, i.quoted_sent FROM chat_items i + LEFT JOIN files f ON f.chat_item_id = i.chat_item_id LEFT JOIN chat_items ri ON i.quoted_shared_msg_id = ri.shared_msg_id WHERE i.user_id = ? AND i.contact_id = ? AND i.chat_item_id = ? |] @@ -3265,6 +3299,8 @@ getGroupChatItem_ db User {userId, userContactId} groupId itemId = do SELECT -- ChatItem i.chat_item_id, i.item_ts, i.item_content, i.item_text, i.item_status, i.shared_msg_id, i.item_deleted, i.item_edited, i.created_at, + -- CIFile + f.file_id, f.file_name, f.file_size, f.file_path, f.ci_file_status, -- GroupMember m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status, m.invited_by, m.local_display_name, m.contact_id, @@ -3276,6 +3312,7 @@ getGroupChatItem_ db User {userId, userContactId} groupId itemId = do rm.member_status, rm.invited_by, rm.local_display_name, rm.contact_id, rp.display_name, rp.full_name, rp.image FROM chat_items i + LEFT JOIN files f ON f.chat_item_id = i.chat_item_id LEFT JOIN group_members m ON m.group_member_id = i.group_member_id LEFT JOIN contact_profiles p ON p.contact_profile_id = m.contact_profile_id LEFT JOIN chat_items ri ON i.quoted_shared_msg_id = ri.shared_msg_id @@ -3359,20 +3396,14 @@ type ChatStatsRow = (Int, ChatItemId) toChatStats :: ChatStatsRow -> ChatStats toChatStats (unreadCount, minUnreadItemId) = ChatStats {unreadCount, minUnreadItemId} -type ChatItemRow = (Int64, ChatItemTs, ACIContent, Text, ACIStatus, Maybe SharedMsgId, Bool, Maybe Bool, UTCTime) +type MaybeCIFIleRow = (Maybe Int64, Maybe String, Maybe Integer, Maybe FilePath, Maybe ACIFileStatus) -type MaybeChatItemRow = (Maybe Int64, Maybe ChatItemTs, Maybe ACIContent, Maybe Text, Maybe ACIStatus, Maybe SharedMsgId, Maybe Bool, Maybe Bool, Maybe UTCTime) +type ChatItemRow = (Int64, ChatItemTs, ACIContent, Text, ACIStatus, Maybe SharedMsgId, Bool, Maybe Bool, UTCTime) :. MaybeCIFIleRow + +type MaybeChatItemRow = (Maybe Int64, Maybe ChatItemTs, Maybe ACIContent, Maybe Text, Maybe ACIStatus, Maybe SharedMsgId, Maybe Bool, Maybe Bool, Maybe UTCTime) :. MaybeCIFIleRow type QuoteRow = (Maybe ChatItemId, Maybe SharedMsgId, Maybe UTCTime, Maybe MsgContent, Maybe Bool) --- type DirectChatItemRow = ChatItemRow :. DirectQuoteRow - --- type MaybeDirectChatItemRow = MaybeChatItemRow :. DirectQuoteRow - --- toQuoteData :: QuoteDataRow -> Maybe CIQuoteData --- toQuoteData (quotedItemId, quotedSentAt, quotedMsgContent) = --- CIQuoteData quotedItemId <$> quotedSentAt <*> quotedMsgContent <*> (parseMaybeMarkdownList . msgContentText <$> quotedMsgContent) - toDirectQuote :: QuoteRow -> Maybe (CIQuote 'CTDirect) toDirectQuote qr@(_, _, _, _, quotedSent) = toQuote qr $ direction <$> quotedSent where @@ -3383,22 +3414,33 @@ toQuote (quotedItemId, quotedSharedMsgId, quotedSentAt, quotedMsgContent, _) dir CIQuote <$> dir <*> pure quotedItemId <*> pure quotedSharedMsgId <*> quotedSentAt <*> quotedMsgContent <*> (parseMaybeMarkdownList . msgContentText <$> quotedMsgContent) toDirectChatItem :: TimeZone -> UTCTime -> ChatItemRow :. QuoteRow -> Either StoreError (CChatItem 'CTDirect) -toDirectChatItem tz currentTs ((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt) :. quoteRow) = - case (itemContent, itemStatus) of - (ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus) -> Right $ cItem SMDSnd CIDirectSnd ciStatus ciContent - (ACIContent SMDRcv ciContent, ACIStatus SMDRcv ciStatus) -> Right $ cItem SMDRcv CIDirectRcv ciStatus ciContent +toDirectChatItem tz currentTs (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt) :. (fileId_, fileName_, fileSize_, filePath, fileStatus_)) :. quoteRow) = + case (itemContent, itemStatus, fileStatus_) of + (ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus, Just (AFS SMDSnd fileStatus)) -> + Right $ cItem SMDSnd CIDirectSnd ciStatus ciContent (maybeCIFile fileStatus) + (ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus, Nothing) -> + Right $ cItem SMDSnd CIDirectSnd ciStatus ciContent Nothing + (ACIContent SMDRcv ciContent, ACIStatus SMDRcv ciStatus, Just (AFS SMDRcv fileStatus)) -> + Right $ cItem SMDRcv CIDirectRcv ciStatus ciContent (maybeCIFile fileStatus) + (ACIContent SMDRcv ciContent, ACIStatus SMDRcv ciStatus, Nothing) -> + Right $ cItem SMDRcv CIDirectRcv ciStatus ciContent Nothing _ -> badItem where - cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTDirect d -> CIStatus d -> CIContent d -> CChatItem 'CTDirect - cItem d chatDir ciStatus content = - CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toDirectQuote quoteRow, file = Nothing} + maybeCIFile :: CIFileStatus d -> Maybe (CIFile d) + maybeCIFile fileStatus = + case (fileId_, fileName_, fileSize_) of + (Just fileId, Just fileName, Just fileSize) -> Just CIFile {fileId, fileName, fileSize, filePath, fileStatus} + _ -> Nothing + cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTDirect d -> CIStatus d -> CIContent d -> Maybe (CIFile d) -> CChatItem 'CTDirect + cItem d chatDir ciStatus content file = + CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toDirectQuote quoteRow, file} badItem = Left $ SEBadChatItem itemId ciMeta :: CIContent d -> CIStatus d -> CIMeta d ciMeta content status = mkCIMeta itemId content itemText status sharedMsgId itemDeleted (fromMaybe False itemEdited) tz currentTs itemTs createdAt toDirectChatItemList :: TimeZone -> UTCTime -> MaybeChatItemRow :. QuoteRow -> [CChatItem 'CTDirect] -toDirectChatItemList tz currentTs ((Just itemId, Just itemTs, Just itemContent, Just itemText, Just itemStatus, sharedMsgId, Just itemDeleted, itemEdited, Just createdAt) :. quoteRow) = - either (const []) (: []) $ toDirectChatItem tz currentTs ((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt) :. quoteRow) +toDirectChatItemList tz currentTs (((Just itemId, Just itemTs, Just itemContent, Just itemText, Just itemStatus, sharedMsgId, Just itemDeleted, itemEdited, Just createdAt) :. fileRow) :. quoteRow) = + either (const []) (: []) $ toDirectChatItem tz currentTs (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt) :. fileRow) :. quoteRow) toDirectChatItemList _ _ _ = [] type GroupQuoteRow = QuoteRow :. MaybeGroupMemberRow @@ -3414,24 +3456,35 @@ toGroupQuote qr@(_, _, _, _, quotedSent) quotedMember_ = toQuote qr $ direction direction _ _ = Nothing toGroupChatItem :: TimeZone -> UTCTime -> Int64 -> ChatItemRow :. MaybeGroupMemberRow :. GroupQuoteRow -> Either StoreError (CChatItem 'CTGroup) -toGroupChatItem tz currentTs userContactId ((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt) :. memberRow_ :. quoteRow :. quotedMemberRow_) = do +toGroupChatItem tz currentTs userContactId (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt) :. (fileId_, fileName_, fileSize_, filePath, fileStatus_)) :. memberRow_ :. quoteRow :. quotedMemberRow_) = do let member_ = toMaybeGroupMember userContactId memberRow_ let quotedMember_ = toMaybeGroupMember userContactId quotedMemberRow_ - case (itemContent, itemStatus, member_) of - (ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus, _) -> Right $ cItem SMDSnd CIGroupSnd ciStatus ciContent quotedMember_ - (ACIContent SMDRcv ciContent, ACIStatus SMDRcv ciStatus, Just member) -> Right $ cItem SMDRcv (CIGroupRcv member) ciStatus ciContent quotedMember_ + case (itemContent, itemStatus, member_, fileStatus_) of + (ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus, _, Just (AFS SMDSnd fileStatus)) -> + Right $ cItem SMDSnd CIGroupSnd ciStatus ciContent quotedMember_ (maybeCIFile fileStatus) + (ACIContent SMDSnd ciContent, ACIStatus SMDSnd ciStatus, _, Nothing) -> + Right $ cItem SMDSnd CIGroupSnd ciStatus ciContent quotedMember_ Nothing + (ACIContent SMDRcv ciContent, ACIStatus SMDRcv ciStatus, Just member, Just (AFS SMDRcv fileStatus)) -> + Right $ cItem SMDRcv (CIGroupRcv member) ciStatus ciContent quotedMember_ (maybeCIFile fileStatus) + (ACIContent SMDRcv ciContent, ACIStatus SMDRcv ciStatus, Just member, Nothing) -> + Right $ cItem SMDRcv (CIGroupRcv member) ciStatus ciContent quotedMember_ Nothing _ -> badItem where - cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTGroup d -> CIStatus d -> CIContent d -> Maybe GroupMember -> CChatItem 'CTGroup - cItem d chatDir ciStatus content quotedMember_ = - CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toGroupQuote quoteRow quotedMember_, file = Nothing} + maybeCIFile :: CIFileStatus d -> Maybe (CIFile d) + maybeCIFile fileStatus = + case (fileId_, fileName_, fileSize_) of + (Just fileId, Just fileName, Just fileSize) -> Just CIFile {fileId, fileName, fileSize, filePath, fileStatus} + _ -> Nothing + cItem :: MsgDirectionI d => SMsgDirection d -> CIDirection 'CTGroup d -> CIStatus d -> CIContent d -> Maybe GroupMember -> Maybe (CIFile d) -> CChatItem 'CTGroup + cItem d chatDir ciStatus content quotedMember_ file = + CChatItem d ChatItem {chatDir, meta = ciMeta content ciStatus, content, formattedText = parseMaybeMarkdownList itemText, quotedItem = toGroupQuote quoteRow quotedMember_, file} badItem = Left $ SEBadChatItem itemId ciMeta :: CIContent d -> CIStatus d -> CIMeta d ciMeta content status = mkCIMeta itemId content itemText status sharedMsgId itemDeleted (fromMaybe False itemEdited) tz currentTs itemTs createdAt toGroupChatItemList :: TimeZone -> UTCTime -> Int64 -> MaybeGroupChatItemRow -> [CChatItem 'CTGroup] -toGroupChatItemList tz currentTs userContactId ((Just itemId, Just itemTs, Just itemContent, Just itemText, Just itemStatus, sharedMsgId, Just itemDeleted, itemEdited, Just createdAt) :. memberRow_ :. quoteRow :. quotedMemberRow_) = - either (const []) (: []) $ toGroupChatItem tz currentTs userContactId ((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt) :. memberRow_ :. quoteRow :. quotedMemberRow_) +toGroupChatItemList tz currentTs userContactId (((Just itemId, Just itemTs, Just itemContent, Just itemText, Just itemStatus, sharedMsgId, Just itemDeleted, itemEdited, Just createdAt) :. fileRow) :. memberRow_ :. quoteRow :. quotedMemberRow_) = + either (const []) (: []) $ toGroupChatItem tz currentTs userContactId (((itemId, itemTs, itemContent, itemText, itemStatus, sharedMsgId, itemDeleted, itemEdited, createdAt) :. fileRow) :. memberRow_ :. quoteRow :. quotedMemberRow_) toGroupChatItemList _ _ _ _ = [] getSMPServers :: MonadUnliftIO m => SQLiteStore -> User -> m [SMPServer] diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 5ef9be10c3..c1d1d73a47 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -156,54 +156,69 @@ responseToView testView = \case testViewChat :: AChat -> [StyledString] testViewChat (AChat _ Chat {chatItems}) = [sShow $ map toChatView chatItems] where - toChatView :: CChatItem c -> ((Int, Text), Maybe (Int, Text)) - toChatView (CChatItem dir ChatItem {meta, quotedItem}) = - ((msgDirectionInt $ toMsgDirection dir, itemText meta),) $ case quotedItem of - Nothing -> Nothing - Just CIQuote {chatDir = quoteDir, content} -> - Just (msgDirectionInt $ quoteMsgDirection quoteDir, msgContentText content) + toChatView :: CChatItem c -> ((Int, Text), Maybe (Int, Text), Maybe String) + toChatView (CChatItem dir ChatItem {meta, quotedItem, file}) = + ((msgDirectionInt $ toMsgDirection dir, itemText meta), qItem, fPath) + where + qItem = case quotedItem of + Nothing -> Nothing + Just CIQuote {chatDir = quoteDir, content} -> + Just (msgDirectionInt $ quoteMsgDirection quoteDir, msgContentText content) + fPath = case file of + Just CIFile {filePath = Just fp} -> Just fp + _ -> Nothing viewErrorsSummary :: [a] -> StyledString -> [StyledString] viewErrorsSummary summary s = [ttyError (T.pack . show $ length summary) <> s <> " (run with -c option to show each error)" | not (null summary)] viewChatItem :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> [StyledString] -viewChatItem chat ChatItem {chatDir, meta, content, quotedItem} = case chat of +viewChatItem chat ChatItem {chatDir, meta, content, quotedItem, file} = case chat of DirectChat c -> case chatDir of CIDirectSnd -> case content of - CISndMsgContent mc -> viewSentMessage to quote mc meta + CISndMsgContent mc -> withSndFile to $ sndMsg to quote mc CISndDeleted _ -> [] - CISndFileInvitation fId fPath -> viewSentFileInvitation to fId fPath meta where to = ttyToContact' c CIDirectRcv -> case content of - CIRcvMsgContent mc -> viewReceivedMessage from quote meta mc + CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc CIRcvDeleted _ -> [] - CIRcvFileInvitation ft -> viewReceivedFileInvitation from meta ft where from = ttyFromContact' c where quote = maybe [] (directQuote chatDir) quotedItem GroupChat g -> case chatDir of CIGroupSnd -> case content of - CISndMsgContent mc -> viewSentMessage to quote mc meta + CISndMsgContent mc -> withSndFile to $ sndMsg to quote mc CISndDeleted _ -> [] - CISndFileInvitation fId fPath -> viewSentFileInvitation to fId fPath meta where to = ttyToGroup g CIGroupRcv m -> case content of - CIRcvMsgContent mc -> viewReceivedMessage from quote meta mc + CIRcvMsgContent mc -> withRcvFile from $ rcvMsg from quote mc CIRcvDeleted _ -> [] - CIRcvFileInvitation ft -> viewReceivedFileInvitation from meta ft where from = ttyFromGroup' g m where quote = maybe [] (groupQuote g) quotedItem _ -> [] + where + sndMsg to quote mc = case (msgContentText mc, file) of + ("", Just _) -> [] + _ -> viewSentMessage to quote mc meta + withSndFile to l = case file of + -- TODO pass CIFile + Just CIFile {fileId, filePath = Just fPath} -> l <> viewSentFileInvitation to fileId fPath meta + _ -> l + rcvMsg from quote mc = case (msgContentText mc, file) of + ("", Just _) -> [] + _ -> viewReceivedMessage from quote mc meta + withRcvFile from l = case file of + Just f -> l <> viewReceivedFileInvitation from f meta + _ -> l viewItemUpdate :: MsgDirectionI d => ChatInfo c -> ChatItem c d -> [StyledString] viewItemUpdate chat ChatItem {chatDir, meta, content, quotedItem} = case chat of DirectChat Contact {localDisplayName = c} -> case chatDir of CIDirectRcv -> case content of - CIRcvMsgContent mc -> viewReceivedMessage from quote meta mc + CIRcvMsgContent mc -> viewReceivedMessage from quote mc meta _ -> [] where from = ttyFromContactEdited c @@ -211,7 +226,7 @@ viewItemUpdate chat ChatItem {chatDir, meta, content, quotedItem} = case chat of CIDirectSnd -> ["message updated"] GroupChat g -> case chatDir of CIGroupRcv GroupMember {localDisplayName = m} -> case content of - CIRcvMsgContent mc -> viewReceivedMessage from quote meta mc + CIRcvMsgContent mc -> viewReceivedMessage from quote mc meta _ -> [] where from = ttyFromGroupEdited g m @@ -223,13 +238,13 @@ viewItemDelete :: ChatInfo c -> ChatItem c d -> ChatItem c' d' -> [StyledString] viewItemDelete chat ChatItem {chatDir, meta, content = deletedContent} ChatItem {content = toContent} = case chat of DirectChat Contact {localDisplayName = c} -> case (chatDir, deletedContent, toContent) of (CIDirectRcv, CIRcvMsgContent mc, CIRcvDeleted mode) -> case mode of - CIDMBroadcast -> viewReceivedMessage (ttyFromContactDeleted c) [] meta mc + CIDMBroadcast -> viewReceivedMessage (ttyFromContactDeleted c) [] mc meta CIDMInternal -> ["message deleted"] (CIDirectSnd, _, _) -> ["message deleted"] _ -> [] GroupChat g -> case (chatDir, deletedContent, toContent) of (CIGroupRcv GroupMember {localDisplayName = m}, CIRcvMsgContent mc, CIRcvDeleted mode) -> case mode of - CIDMBroadcast -> viewReceivedMessage (ttyFromGroupDeleted g m) [] meta mc + CIDMBroadcast -> viewReceivedMessage (ttyFromGroupDeleted g m) [] mc meta CIDMInternal -> ["message deleted"] (CIGroupSnd, _, _) -> ["message deleted"] _ -> [] @@ -434,8 +449,8 @@ viewContactUpdated where fullNameUpdate = if T.null fullName' || fullName' == n' then " removed full name" else " updated full name: " <> plain fullName' -viewReceivedMessage :: StyledString -> [StyledString] -> CIMeta d -> MsgContent -> [StyledString] -viewReceivedMessage from quote meta = receivedWithTime_ from quote meta . ttyMsgContent +viewReceivedMessage :: StyledString -> [StyledString] -> MsgContent -> CIMeta d -> [StyledString] +viewReceivedMessage from quote mc meta = receivedWithTime_ from quote meta (ttyMsgContent mc) receivedWithTime_ :: StyledString -> [StyledString] -> CIMeta d -> [StyledString] -> [StyledString] receivedWithTime_ from quote CIMeta {localItemTs, createdAt} styledMsg = do @@ -454,7 +469,7 @@ receivedWithTime_ from quote CIMeta {localItemTs, createdAt} styledMsg = do in styleTime $ formatTime defaultTimeLocale format localTime viewSentMessage :: StyledString -> [StyledString] -> MsgContent -> CIMeta d -> [StyledString] -viewSentMessage to quote mc = sentWithTime_ . prependFirst to $ quote <> prependFirst indent (ttyMsgContent mc) +viewSentMessage to quote mc = sentWithTime_ (prependFirst to $ quote <> prependFirst indent (ttyMsgContent mc)) where indent = if null quote then "" else " " @@ -501,11 +516,22 @@ sendingFile_ status ft@SndFileTransfer {recipientDisplayName = c} = sndFile :: SndFileTransfer -> StyledString sndFile SndFileTransfer {fileId, fileName} = fileTransferStr fileId fileName -viewReceivedFileInvitation :: StyledString -> CIMeta d -> RcvFileTransfer -> [StyledString] -viewReceivedFileInvitation from meta ft = receivedWithTime_ from [] meta (receivedFileInvitation_ ft) +viewReceivedFileInvitation :: StyledString -> CIFile d -> CIMeta d -> [StyledString] +viewReceivedFileInvitation from file meta = receivedWithTime_ from [] meta (receivedFileInvitation_ file) -receivedFileInvitation_ :: RcvFileTransfer -> [StyledString] -receivedFileInvitation_ RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName, fileSize}} = +receivedFileInvitation_ :: CIFile d -> [StyledString] +receivedFileInvitation_ CIFile {fileId, fileName, fileSize} = + [ "sends file " <> ttyFilePath fileName <> " (" <> humanReadableSize fileSize <> " / " <> sShow fileSize <> " bytes)", + -- below is printed for auto-accepted files as well; auto-accept is disabled in terminal though so in reality it never happens + "use " <> highlight ("/fr " <> show fileId <> " [/ | ]") <> " to receive it" + ] + +-- TODO remove +viewReceivedFileInvitation' :: StyledString -> RcvFileTransfer -> CIMeta d -> [StyledString] +viewReceivedFileInvitation' from RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName, fileSize}} meta = receivedWithTime_ from [] meta (receivedFileInvitation_' fileId fileName fileSize) + +receivedFileInvitation_' :: Int64 -> String -> Integer -> [StyledString] +receivedFileInvitation_' fileId fileName fileSize = [ "sends file " <> ttyFilePath fileName <> " (" <> humanReadableSize fileSize <> " / " <> sShow fileSize <> " bytes)", "use " <> highlight ("/fr " <> show fileId <> " [/ | ]") <> " to receive it" ] diff --git a/tests/ChatClient.hs b/tests/ChatClient.hs index 42cc82b908..28f44e294c 100644 --- a/tests/ChatClient.hs +++ b/tests/ChatClient.hs @@ -125,6 +125,7 @@ testChatN ps test = withTmpFiles $ do test tcs concurrentlyN_ $ map ( [TestCC] -> IO [TestCC] getTestCCs [] tcs = pure tcs getTestCCs ((p, db) : envs') tcs = (:) <$> virtualSimplexChat db p <*> getTestCCs envs' tcs diff --git a/tests/ChatTests.hs b/tests/ChatTests.hs index dd450b132a..f6875594e5 100644 --- a/tests/ChatTests.hs +++ b/tests/ChatTests.hs @@ -63,6 +63,12 @@ chatTests = do it "sender cancelled file transfer" testFileSndCancelV2 it "recipient cancelled file transfer" testFileRcvCancelV2 it "send and receive file to group" testGroupFileTransferV2 + describe "messages with files" $ do + it "send and receive message with file" testMessageWithFile + it "send and receive image" testSendImage + it "send and receive image with text and quote" testSendImageWithTextAndQuote + it "send and receive image to group" testGroupSendImage + it "send and receive image with text and quote to group" testGroupSendImageWithTextAndQuote describe "user contact link" $ do it "create and connect via contact link" testUserContactLink it "auto accept contact requests" testUserContactLinkAutoAccept @@ -239,7 +245,7 @@ testDirectMessageDelete = alice #$> ("/_get chat @2 count=100", chat, []) alice #$> ("/_update item @2 1 text updating deleted message", id, "cannot update this item") - alice #$> ("/_send_quote @2 1 text quoting deleted message", id, "cannot reply to this message") + alice #$> ("/_send @2 quoted 1 text quoting deleted message", id, "cannot reply to this message") bob #$> ("/_update item @2 2 text hey alice", id, "message updated") alice <# "bob> [edited] hey alice" @@ -829,7 +835,7 @@ testGroupMessageDelete = cath #$> ("/_get chat #1 count=100", chat, [(0, "hello!")]) alice #$> ("/_update item #1 1 text updating deleted message", id, "cannot update this item") - alice #$> ("/_send_quote #1 1 text quoting deleted message", id, "cannot reply to this message") + alice #$> ("/_send #1 quoted 1 text quoting deleted message", id, "cannot reply to this message") threadDelay 1000000 -- msg id 2 @@ -1206,6 +1212,192 @@ testGroupFileTransferV2 = cath <## "completed receiving file 1 (test.jpg) from alice" ] +testMessageWithFile :: IO () +testMessageWithFile = + testChat2 aliceProfile bobProfile $ + \alice bob -> do + connectUsers alice bob + alice ##> "/_send @2 file ./tests/fixtures/test.jpg text hi, sending a file" + alice <# "@bob hi, sending a file" + alice <# "/f @bob ./tests/fixtures/test.jpg" + alice <## "use /fc 1 to cancel sending" + bob <# "alice> hi, sending a file" + bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)" + bob <## "use /fr 1 [/ | ] to receive it" + bob ##> "/fr 1 ./tests/tmp" + bob <## "saving file 1 from alice to ./tests/tmp/test.jpg" + concurrently_ + (bob <## "started receiving file 1 (test.jpg) from alice") + (alice <## "started sending file 1 (test.jpg) to bob") + concurrently_ + (bob <## "completed receiving file 1 (test.jpg) from alice") + (alice <## "completed sending file 1 (test.jpg) to bob") + src <- B.readFile "./tests/fixtures/test.jpg" + dest <- B.readFile "./tests/tmp/test.jpg" + dest `shouldBe` src + alice #$> ("/_get chat @2 count=100", chatF, [((1, "hi, sending a file"), Just "./tests/fixtures/test.jpg")]) + bob #$> ("/_get chat @2 count=100", chatF, [((0, "hi, sending a file"), Just "./tests/tmp/test.jpg")]) + +testSendImage :: IO () +testSendImage = + testChat2 aliceProfile bobProfile $ + \alice bob -> do + connectUsers alice bob + alice ##> "/_send @2 file ./tests/fixtures/test.jpg json {\"text\":\"\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}" + alice <# "/f @bob ./tests/fixtures/test.jpg" + alice <## "use /fc 1 to cancel sending" + bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)" + bob <## "use /fr 1 [/ | ] to receive it" + bob ##> "/fr 1 ./tests/tmp" + bob <## "saving file 1 from alice to ./tests/tmp/test.jpg" + concurrently_ + (bob <## "started receiving file 1 (test.jpg) from alice") + (alice <## "started sending file 1 (test.jpg) to bob") + concurrently_ + (bob <## "completed receiving file 1 (test.jpg) from alice") + (alice <## "completed sending file 1 (test.jpg) to bob") + src <- B.readFile "./tests/fixtures/test.jpg" + dest <- B.readFile "./tests/tmp/test.jpg" + dest `shouldBe` src + alice #$> ("/_get chat @2 count=100", chatF, [((1, ""), Just "./tests/fixtures/test.jpg")]) + bob #$> ("/_get chat @2 count=100", chatF, [((0, ""), Just "./tests/tmp/test.jpg")]) + +testSendImageWithTextAndQuote :: IO () +testSendImageWithTextAndQuote = + testChat2 aliceProfile bobProfile $ + \alice bob -> do + connectUsers alice bob + bob #> "@alice hi alice" + alice <# "bob> hi alice" + alice ##> "/_send @2 file ./tests/fixtures/test.jpg quoted 1 json {\"text\":\"hey bob\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}" + alice <# "@bob > hi alice" + alice <## " hey bob" + alice <# "/f @bob ./tests/fixtures/test.jpg" + alice <## "use /fc 1 to cancel sending" + bob <# "alice> > hi alice" + bob <## " hey bob" + bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)" + bob <## "use /fr 1 [/ | ] to receive it" + bob ##> "/fr 1 ./tests/tmp" + bob <## "saving file 1 from alice to ./tests/tmp/test.jpg" + concurrently_ + (bob <## "started receiving file 1 (test.jpg) from alice") + (alice <## "started sending file 1 (test.jpg) to bob") + concurrently_ + (bob <## "completed receiving file 1 (test.jpg) from alice") + (alice <## "completed sending file 1 (test.jpg) to bob") + src <- B.readFile "./tests/fixtures/test.jpg" + dest <- B.readFile "./tests/tmp/test.jpg" + dest `shouldBe` src + alice #$> ("/_get chat @2 count=100", chat'', [((0, "hi alice"), Nothing, Nothing), ((1, "hey bob"), Just (0, "hi alice"), Just "./tests/fixtures/test.jpg")]) + alice #$$> ("/_get chats", [("@bob", "hey bob")]) + bob #$> ("/_get chat @2 count=100", chat'', [((1, "hi alice"), Nothing, Nothing), ((0, "hey bob"), Just (1, "hi alice"), Just "./tests/tmp/test.jpg")]) + bob #$$> ("/_get chats", [("@alice", "hey bob")]) + +testGroupSendImage :: IO () +testGroupSendImage = + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> do + createGroup3 "team" alice bob cath + alice ##> "/_send #1 file ./tests/fixtures/test.jpg json {\"text\":\"\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}" + alice <# "/f #team ./tests/fixtures/test.jpg" + alice <## "use /fc 1 to cancel sending" + concurrentlyN_ + [ do + bob <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)" + bob <## "use /fr 1 [/ | ] to receive it", + do + cath <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)" + cath <## "use /fr 1 [/ | ] to receive it" + ] + bob ##> "/fr 1 ./tests/tmp/" + bob <## "saving file 1 from alice to ./tests/tmp/test.jpg" + concurrentlyN_ + [ do + alice <## "started sending file 1 (test.jpg) to bob" + alice <## "completed sending file 1 (test.jpg) to bob", + do + bob <## "started receiving file 1 (test.jpg) from alice" + bob <## "completed receiving file 1 (test.jpg) from alice" + ] + cath ##> "/fr 1 ./tests/tmp/" + cath <## "saving file 1 from alice to ./tests/tmp/test_1.jpg" + concurrentlyN_ + [ do + alice <## "started sending file 1 (test.jpg) to cath" + alice <## "completed sending file 1 (test.jpg) to cath", + do + cath <## "started receiving file 1 (test.jpg) from alice" + cath <## "completed receiving file 1 (test.jpg) from alice" + ] + src <- B.readFile "./tests/fixtures/test.jpg" + dest <- B.readFile "./tests/tmp/test.jpg" + dest `shouldBe` src + dest2 <- B.readFile "./tests/tmp/test_1.jpg" + dest2 `shouldBe` src + alice #$> ("/_get chat #1 count=100", chatF, [((1, ""), Just "./tests/fixtures/test.jpg")]) + bob #$> ("/_get chat #1 count=100", chatF, [((0, ""), Just "./tests/tmp/test.jpg")]) + cath #$> ("/_get chat #1 count=100", chatF, [((0, ""), Just "./tests/tmp/test_1.jpg")]) + +testGroupSendImageWithTextAndQuote :: IO () +testGroupSendImageWithTextAndQuote = + testChat3 aliceProfile bobProfile cathProfile $ + \alice bob cath -> do + createGroup3 "team" alice bob cath + bob #> "#team hi team" + concurrently_ + (alice <# "#team bob> hi team") + (cath <# "#team bob> hi team") + threadDelay 1000000 + alice ##> "/_send #1 file ./tests/fixtures/test.jpg quoted 1 json {\"text\":\"hey bob\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}" + alice <# "#team > bob hi team" + alice <## " hey bob" + alice <# "/f #team ./tests/fixtures/test.jpg" + alice <## "use /fc 1 to cancel sending" + concurrentlyN_ + [ do + bob <# "#team alice> > bob hi team" + bob <## " hey bob" + bob <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)" + bob <## "use /fr 1 [/ | ] to receive it", + do + cath <# "#team alice> > bob hi team" + cath <## " hey bob" + cath <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)" + cath <## "use /fr 1 [/ | ] to receive it" + ] + bob ##> "/fr 1 ./tests/tmp/" + bob <## "saving file 1 from alice to ./tests/tmp/test.jpg" + concurrentlyN_ + [ do + alice <## "started sending file 1 (test.jpg) to bob" + alice <## "completed sending file 1 (test.jpg) to bob", + do + bob <## "started receiving file 1 (test.jpg) from alice" + bob <## "completed receiving file 1 (test.jpg) from alice" + ] + cath ##> "/fr 1 ./tests/tmp/" + cath <## "saving file 1 from alice to ./tests/tmp/test_1.jpg" + concurrentlyN_ + [ do + alice <## "started sending file 1 (test.jpg) to cath" + alice <## "completed sending file 1 (test.jpg) to cath", + do + cath <## "started receiving file 1 (test.jpg) from alice" + cath <## "completed receiving file 1 (test.jpg) from alice" + ] + src <- B.readFile "./tests/fixtures/test.jpg" + dest <- B.readFile "./tests/tmp/test.jpg" + dest `shouldBe` src + dest2 <- B.readFile "./tests/tmp/test_1.jpg" + dest2 `shouldBe` src + alice #$> ("/_get chat #1 count=100", chat'', [((0, "hi team"), Nothing, Nothing), ((1, "hey bob"), Just (0, "hi team"), Just "./tests/fixtures/test.jpg")]) + alice #$$> ("/_get chats", [("#team", "hey bob"), ("@bob", ""), ("@cath", "")]) + bob #$> ("/_get chat #1 count=100", chat'', [((1, "hi team"), Nothing, Nothing), ((0, "hey bob"), Just (1, "hi team"), Just "./tests/tmp/test.jpg")]) + bob #$$> ("/_get chats", [("#team", "hey bob"), ("@alice", ""), ("@cath", "")]) + cath #$> ("/_get chat #1 count=100", chat'', [((0, "hi team"), Nothing, Nothing), ((0, "hey bob"), Just (0, "hi team"), Just "./tests/tmp/test_1.jpg")]) + cath #$$> ("/_get chats", [("#team", "hey bob"), ("@alice", ""), ("@bob", "")]) + testUserContactLink :: IO () testUserContactLink = testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do @@ -1567,10 +1759,16 @@ cc #$> (cmd, f, res) = do (f <$> getTermLine cc) `shouldReturn` res chat :: String -> [(Int, String)] -chat = map fst . chat' +chat = map (\(a, _, _) -> a) . chat'' chat' :: String -> [((Int, String), Maybe (Int, String))] -chat' = read +chat' = map (\(a, b, _) -> (a, b)) . chat'' + +chatF :: String -> [((Int, String), Maybe String)] +chatF = map (\(a, _, c) -> (a, c)) . chat'' + +chat'' :: String -> [((Int, String), Maybe (Int, String), Maybe String)] +chat'' = read (#$$>) :: TestCC -> (String, [(String, String)]) -> Expectation cc #$$> (cmd, res) = do diff --git a/tests/ProtocolTests.hs b/tests/ProtocolTests.hs index b5da5bb901..9b37be14a9 100644 --- a/tests/ProtocolTests.hs +++ b/tests/ProtocolTests.hs @@ -96,8 +96,11 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do "{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"https://simplex.chat\",\"type\":\"link\",\"preview\":{\"description\":\"SimpleX Chat\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgA\",\"title\":\"SimpleX Chat\",\"uri\":\"https://simplex.chat\"}}}}" #==# XMsgNew (MCSimple (ExtMsgContent (MCLink "https://simplex.chat" $ LinkPreview {uri = "https://simplex.chat", title = "SimpleX Chat", description = "SimpleX Chat", image = ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgA"}) Nothing)) it "x.msg.new simple image" $ - "{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"https://simplex.chat\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}" - #==# XMsgNew (MCSimple (ExtMsgContent (MCImage "https://simplex.chat" $ ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=") Nothing)) + "{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}" + #==# XMsgNew (MCSimple (ExtMsgContent (MCImage "" $ ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=") Nothing)) + it "x.msg.new simple image with text" $ + "{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"here's an image\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}}" + #==# XMsgNew (MCSimple (ExtMsgContent (MCImage "here's an image" $ ImageData "data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=") Nothing)) it "x.msg.new chat message " $ "{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"}}}" ##==## (ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew (MCSimple (ExtMsgContent (MCText "hello") Nothing)))) @@ -120,10 +123,10 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do it "x.msg.new forward" $ "{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true}}" ##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (ExtMsgContent (MCText "hello") Nothing)) - it "x.msg.new simple with file invitation" $ + it "x.msg.new simple with file" $ "{\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}" #==# XMsgNew (MCSimple (ExtMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = Nothing}))) - it "x.msg.new quote with file invitation" $ + it "x.msg.new quote with file" $ "{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello to you too\",\"type\":\"text\"},\"quote\":{\"content\":{\"text\":\"hello there!\",\"type\":\"text\"},\"msgRef\":{\"msgId\":\"BQYHCA==\",\"sent\":true,\"sentAt\":\"1970-01-01T00:00:01.000000001Z\"}},\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}" ##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") @@ -139,7 +142,7 @@ decodeChatMessageTest = describe "Chat message encoding/decoding" $ do ) ) ) - it "x.msg.new forward with file invitation" $ + it "x.msg.new forward with file" $ "{\"msgId\":\"AQIDBA==\",\"event\":\"x.msg.new\",\"params\":{\"content\":{\"text\":\"hello\",\"type\":\"text\"},\"forward\":true,\"file\":{\"fileSize\":12345,\"fileName\":\"photo.jpg\"}}}" ##==## ChatMessage (Just $ SharedMsgId "\1\2\3\4") (XMsgNew $ MCForward (ExtMsgContent (MCText "hello") (Just FileInvitation {fileName = "photo.jpg", fileSize = 12345, fileConnReq = Nothing}))) it "x.msg.update" $