From 6c72db58f55c441e25dce745b420199796047708 Mon Sep 17 00:00:00 2001 From: JRoberts <8711996+jr-simplex@users.noreply.github.com> Date: Fri, 29 Apr 2022 15:56:56 +0400 Subject: [PATCH] core: return AChatItem in FileAccepted and FileStart events (#585) --- src/Simplex/Chat.hs | 22 +++++++++++-------- src/Simplex/Chat/Controller.hs | 4 ++-- src/Simplex/Chat/Messages.hs | 3 +++ src/Simplex/Chat/Store.hs | 39 +++++++++++++++++++--------------- src/Simplex/Chat/View.hs | 14 +++++++++--- 5 files changed, 51 insertions(+), 31 deletions(-) diff --git a/src/Simplex/Chat.hs b/src/Simplex/Chat.hs index dfcb597d70..3d8ad8da35 100644 --- a/src/Simplex/Chat.hs +++ b/src/Simplex/Chat.hs @@ -609,9 +609,10 @@ processChatCommand = \case 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 + (CRRcvFileAccepted <$> acceptFileReceive user ft filePath_) `catchError` processError ft where processError ft = \case + -- TODO AChatItem in Cancelled events ChatErrorAgent (SMP SMP.AUTH) -> pure $ CRRcvFileAcceptedSndCancelled ft ChatErrorAgent (CONN DUPLICATE) -> pure $ CRRcvFileAcceptedSndCancelled ft e -> throwError e @@ -710,6 +711,7 @@ processChatCommand = \case case status of AFS _ CIFSSndStored -> cancelById fileId AFS _ CIFSRcvInvitation -> cancelById fileId + AFS _ CIFSRcvAccepted -> cancelById fileId AFS _ CIFSRcvTransfer -> cancelById fileId _ -> pure () where @@ -742,7 +744,7 @@ toFSFilePath :: ChatMonad m => FilePath -> m FilePath toFSFilePath f = maybe f (<> "/" <> f) <$> (readTVarIO =<< asks filesFolder) -acceptFileReceive :: forall m. ChatMonad m => User -> RcvFileTransfer -> Maybe FilePath -> m FilePath +acceptFileReceive :: forall m. ChatMonad m => User -> RcvFileTransfer -> Maybe FilePath -> m AChatItem 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 @@ -751,8 +753,7 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, fileInvitation = F 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 + withStore $ \st -> acceptRcvFileTransfer st user fileId agentConnId filePath Left e -> throwError e -- new file protocol Nothing -> @@ -767,14 +768,14 @@ acceptFileReceive user@User {userId} RcvFileTransfer {fileId, fileInvitation = F 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 :: (SharedMsgId -> ConnReqInvitation -> m SndMessage) -> m AChatItem 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 + ci <- withStore $ \st -> acceptRcvFileTransfer st user fileId agentConnId filePath void $ sendXFileAcptInv sharedMsgId fileInvConnReq - pure filePath + pure ci where getRcvFilePath :: Maybe FilePath -> String -> m FilePath getRcvFilePath fPath_ fn = case fPath_ of @@ -1176,8 +1177,11 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage XOk -> allowAgentConnection conn confId XOk _ -> pure () CON -> do - withStore $ \st -> updateRcvFileStatus st ft FSConnected - toView $ CRRcvFileStart ft + ci <- withStore $ \st -> do + updateRcvFileStatus st ft FSConnected + updateCIFileStatus st userId fileId CIFSRcvTransfer + getChatItemByFileId st user fileId + toView $ CRRcvFileStart ci MSG meta@MsgMeta {recipient = (msgId, _), integrity} msgBody -> withAckMessage agentConnId meta $ do parseFileChunk msgBody >>= \case FileChunkCancel -> do diff --git a/src/Simplex/Chat/Controller.hs b/src/Simplex/Chat/Controller.hs index ed3b0fa741..a3365f8ead 100644 --- a/src/Simplex/Chat/Controller.hs +++ b/src/Simplex/Chat/Controller.hs @@ -205,9 +205,9 @@ data ChatResponse | CRContactRequestAlreadyAccepted {contact :: Contact} | CRLeftMemberUser {groupInfo :: GroupInfo} | CRGroupDeletedUser {groupInfo :: GroupInfo} - | CRRcvFileAccepted {fileTransfer :: RcvFileTransfer, filePath :: FilePath} + | CRRcvFileAccepted {chatItem :: AChatItem} | CRRcvFileAcceptedSndCancelled {rcvFileTransfer :: RcvFileTransfer} - | CRRcvFileStart {rcvFileTransfer :: RcvFileTransfer} + | CRRcvFileStart {chatItem :: AChatItem} | CRRcvFileComplete {chatItem :: AChatItem} | CRRcvFileCancelled {rcvFileTransfer :: RcvFileTransfer} | CRRcvFileSndCancelled {rcvFileTransfer :: RcvFileTransfer} diff --git a/src/Simplex/Chat/Messages.hs b/src/Simplex/Chat/Messages.hs index 108e208768..a54e779fb2 100644 --- a/src/Simplex/Chat/Messages.hs +++ b/src/Simplex/Chat/Messages.hs @@ -295,6 +295,7 @@ data CIFileStatus (d :: MsgDirection) where CIFSSndStored :: CIFileStatus 'MDSnd CIFSSndCancelled :: CIFileStatus 'MDSnd CIFSRcvInvitation :: CIFileStatus 'MDRcv + CIFSRcvAccepted :: CIFileStatus 'MDRcv CIFSRcvTransfer :: CIFileStatus 'MDRcv CIFSRcvComplete :: CIFileStatus 'MDRcv CIFSRcvCancelled :: CIFileStatus 'MDRcv @@ -318,6 +319,7 @@ instance MsgDirectionI d => StrEncoding (CIFileStatus d) where CIFSSndStored -> "snd_stored" CIFSSndCancelled -> "snd_cancelled" CIFSRcvInvitation -> "rcv_invitation" + CIFSRcvAccepted -> "rcv_accepted" CIFSRcvTransfer -> "rcv_transfer" CIFSRcvComplete -> "rcv_complete" CIFSRcvCancelled -> "rcv_cancelled" @@ -330,6 +332,7 @@ instance StrEncoding ACIFileStatus where "snd_stored" -> pure $ AFS SMDSnd CIFSSndStored "snd_cancelled" -> pure $ AFS SMDSnd CIFSSndCancelled "rcv_invitation" -> pure $ AFS SMDRcv CIFSRcvInvitation + "rcv_accepted" -> pure $ AFS SMDRcv CIFSRcvAccepted "rcv_transfer" -> pure $ AFS SMDRcv CIFSRcvTransfer "rcv_complete" -> pure $ AFS SMDRcv CIFSRcvComplete "rcv_cancelled" -> pure $ AFS SMDRcv CIFSRcvCancelled diff --git a/src/Simplex/Chat/Store.hs b/src/Simplex/Chat/Store.hs index 03760fe3d9..9f4e89fe86 100644 --- a/src/Simplex/Chat/Store.hs +++ b/src/Simplex/Chat/Store.hs @@ -2093,14 +2093,14 @@ getRcvFileTransfer_ db userId fileId = cancelled = fromMaybe False cancelled_ rcvFileTransfer _ = Left $ SERcvFileNotFound fileId -acceptRcvFileTransfer :: StoreMonad m => SQLiteStore -> UserId -> Int64 -> ConnId -> FilePath -> m () -acceptRcvFileTransfer st userId fileId agentConnId filePath = - liftIO . withTransaction st $ \db -> do +acceptRcvFileTransfer :: StoreMonad m => SQLiteStore -> User -> Int64 -> ConnId -> FilePath -> m AChatItem +acceptRcvFileTransfer st user@User {userId} fileId agentConnId filePath = + liftIOEither . withTransaction st $ \db -> do currentTs <- getCurrentTime DB.execute db "UPDATE files SET file_path = ?, ci_file_status = ?, updated_at = ? WHERE user_id = ? AND file_id = ?" - (filePath, CIFSRcvTransfer, currentTs, userId, fileId) + (filePath, CIFSRcvAccepted, currentTs, userId, fileId) DB.execute db "UPDATE rcv_files SET file_status = ?, updated_at = ? WHERE file_id = ?" @@ -2109,6 +2109,7 @@ acceptRcvFileTransfer st userId fileId agentConnId filePath = db "INSERT INTO connections (agent_conn_id, conn_status, conn_type, rcv_file_id, user_id, created_at, updated_at) VALUES (?,?,?,?,?,?,?)" (agentConnId, ConnJoined, ConnRcvFile, fileId, userId, currentTs, currentTs) + getChatItemByFileId_ db user fileId updateRcvFileStatus :: MonadUnliftIO m => SQLiteStore -> RcvFileTransfer -> FileStatus -> m () updateRcvFileStatus st RcvFileTransfer {fileId} status = @@ -3480,19 +3481,23 @@ getGroupChatItemIdByText st User {userId, localDisplayName = userName} groupId c (userId, groupId, cName, quotedMsg <> "%") getChatItemByFileId :: StoreMonad m => SQLiteStore -> User -> Int64 -> m AChatItem -getChatItemByFileId st user@User {userId} fileId = do - liftIOEither . withTransaction st $ \db -> runExceptT $ do - r <- ExceptT $ getChatItemIdByFileId_ db userId fileId - case r of - (itemId, Just contactId, Nothing) -> do - ct <- ExceptT $ getContact_ db userId contactId - (CChatItem msgDir ci) <- ExceptT $ getDirectChatItem_ db userId contactId itemId - pure $ AChatItem SCTDirect msgDir (DirectChat ct) ci - (itemId, Nothing, Just groupId) -> do - gInfo <- ExceptT $ getGroupInfo_ db user groupId - (CChatItem msgDir ci) <- ExceptT $ getGroupChatItem_ db user groupId itemId - pure $ AChatItem SCTGroup msgDir (GroupChat gInfo) ci - _ -> throwError $ SEChatItemNotFoundByFileId fileId +getChatItemByFileId st user fileId = + liftIOEither . withTransaction st $ \db -> + getChatItemByFileId_ db user fileId + +getChatItemByFileId_ :: DB.Connection -> User -> Int64 -> IO (Either StoreError AChatItem) +getChatItemByFileId_ db user@User {userId} fileId = runExceptT $ do + r <- ExceptT $ getChatItemIdByFileId_ db userId fileId + case r of + (itemId, Just contactId, Nothing) -> do + ct <- ExceptT $ getContact_ db userId contactId + (CChatItem msgDir ci) <- ExceptT $ getDirectChatItem_ db userId contactId itemId + pure $ AChatItem SCTDirect msgDir (DirectChat ct) ci + (itemId, Nothing, Just groupId) -> do + gInfo <- ExceptT $ getGroupInfo_ db user groupId + (CChatItem msgDir ci) <- ExceptT $ getGroupChatItem_ db user groupId itemId + pure $ AChatItem SCTGroup msgDir (GroupChat gInfo) ci + _ -> throwError $ SEChatItemNotFoundByFileId fileId getChatItemIdByFileId_ :: DB.Connection -> UserId -> Int64 -> IO (Either StoreError (ChatItemId, Maybe Int64, Maybe Int64)) getChatItemIdByFileId_ db userId fileId = diff --git a/src/Simplex/Chat/View.hs b/src/Simplex/Chat/View.hs index 347c6f013c..fe489e2c72 100644 --- a/src/Simplex/Chat/View.hs +++ b/src/Simplex/Chat/View.hs @@ -92,8 +92,7 @@ responseToView testView = \case CRUserDeletedMember g m -> [ttyGroup' g <> ": you removed " <> ttyMember m <> " from the group"] CRLeftMemberUser g -> [ttyGroup' g <> ": you left the group"] <> groupPreserved g CRGroupDeletedUser g -> [ttyGroup' g <> ": you deleted the group"] - CRRcvFileAccepted RcvFileTransfer {fileId, senderDisplayName = c} filePath -> - ["saving file " <> sShow fileId <> " from " <> ttyContact c <> " to " <> plain filePath] + CRRcvFileAccepted ci -> savingFile' ci CRRcvFileAcceptedSndCancelled ft -> viewRcvFileSndCancelled ft CRSndGroupFileCancelled ftm fts -> viewSndGroupFileCancelled ftm fts CRRcvFileCancelled ft -> receivingFile_ "cancelled" ft @@ -101,7 +100,7 @@ responseToView testView = \case CRContactUpdated c c' -> viewContactUpdated c c' CRContactsMerged intoCt mergedCt -> viewContactsMerged intoCt mergedCt CRReceivedContactRequest UserContactRequest {localDisplayName = c, profile} -> viewReceivedContactRequest c profile - CRRcvFileStart ft -> receivingFile_ "started" ft + CRRcvFileStart ci -> receivingFile_' "started" ci CRRcvFileComplete ci -> receivingFile_' "completed" ci CRRcvFileSndCancelled ft -> viewRcvFileSndCancelled ft CRSndFileStart ft -> sendingFile_ "started" ft @@ -556,6 +555,15 @@ humanReadableSize size mB = kB * 1024 gB = mB * 1024 +savingFile' :: AChatItem -> [StyledString] +savingFile' (AChatItem _ _ (DirectChat Contact {localDisplayName = c}) ChatItem {file = Just CIFile {fileId, filePath = Just filePath}, chatDir = CIDirectRcv}) = + ["saving file " <> sShow fileId <> " from " <> ttyContact c <> " to " <> plain filePath] +savingFile' (AChatItem _ _ _ ChatItem {file = Just CIFile {fileId, filePath = Just filePath}, chatDir = CIGroupRcv GroupMember {localDisplayName = m}}) = + ["saving file " <> sShow fileId <> " from " <> ttyContact m <> " to " <> plain filePath] +savingFile' (AChatItem _ _ _ ChatItem {file = Just CIFile {fileId, filePath = Just filePath}}) = + ["saving file " <> sShow fileId <> " to " <> plain filePath] +savingFile' _ = ["saving file"] -- shouldn't happen + receivingFile_' :: StyledString -> AChatItem -> [StyledString] receivingFile_' status (AChatItem _ _ (DirectChat Contact {localDisplayName = c}) ChatItem {file = Just CIFile {fileId, fileName}, chatDir = CIDirectRcv}) = [status <> " receiving " <> fileTransferStr fileId fileName <> " from " <> ttyContact c]