dandri/simplex-chat
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplex-chat.git synced 2026-08-01 02:50:13 +00:00
Code Issues Packages Projects Releases Wiki Activity

core: return AChatItem in FileAccepted and FileStart events (#585)

Browse Source
This commit is contained in:
JRoberts
2022-04-29 15:56:56 +04:00
committed by GitHub
parent 1df9a1ec2d
commit 6c72db58f5
5 changed files with 51 additions and 31 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Simplex/Chat.hs
+13 -9
View File
@@ -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
src/Simplex/Chat/Controller.hs
+2 -2
View File
@@ -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}
src/Simplex/Chat/Messages.hs
+3
View File
@@ -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
src/Simplex/Chat/Store.hs
+22 -17
View File
@@ -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 =
src/Simplex/Chat/View.hs
+11 -3
View File
@@ -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]