core: discontinue old file protocol (send); use MCFile when sending and receiving files (#587)

This commit is contained in:
JRoberts
2022-04-30 19:18:46 +04:00
committed by GitHub
parent 305052ecaf
commit dd592c7db3
4 changed files with 8 additions and 215 deletions
+7 -61
View File
@@ -552,61 +552,9 @@ processChatCommand = \case
chatRef <- getChatRef user chatName
CRLastMessages . aChatItems . chat <$> (processChatCommand . APIGetChat chatRef $ CPLast count)
LastMessages Nothing _count -> pure $ chatCmdError "not implemented"
-- 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 fileName = takeFileName f
fileInv = FileInvitation {fileName = takeFileName f, fileSize, fileConnReq = Just fileConnReq}
fileId <- withStore $ \st ->
createSndFileTransfer st userId contact f fileInv agentConnId chSize
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 (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
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 ct) ci
-- old file protocol
-- TODO discontinue
SendGroupFile gName f -> withUser $ \user@User {userId} -> withChatLock $ do
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
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 = ""}
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
-- new file protocol
SendGroupFileInv gName f -> withUser $ \user -> do
groupId <- withStore $ \st -> getGroupIdByName st user gName
processChatCommand $ APISendMessage (ChatRef CTGroup groupId) (Just f) Nothing (MCText "")
SendFile chatName f -> withUser $ \user -> do
chatRef <- getChatRef user chatName
processChatCommand $ APISendMessage chatRef (Just f) Nothing (MCFile "")
ReceiveFile fileId filePath_ -> withUser $ \user@User {userId} ->
withChatLock . procCmd $ do
ft <- withStore $ \st -> getRcvFileTransfer st userId fileId
@@ -1389,7 +1337,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
chSize <- asks $ fileChunkSize . config
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
ci <- saveRcvChatItem user (CDDirectRcv ct) msg msgMeta (CIRcvMsgContent $ MCFile "") ciFile
toView . CRNewChatItem $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci
checkIntegrity msgMeta $ toView . CRMsgIntegrityError
showToast (c <> "> ") "wants to send a file"
@@ -1401,7 +1349,7 @@ processAgentMessage (Just user@User {userId, profile}) agentConnId agentMessage
chSize <- asks $ fileChunkSize . config
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
ci <- saveRcvChatItem user (CDGroupRcv gInfo m) msg msgMeta (CIRcvMsgContent $ MCFile "") ciFile
groupMsgToView gInfo ci msgMeta
let g = groupName' gInfo
showToast ("#" <> g <> " " <> c <> "> ") "wants to send a file"
@@ -1967,10 +1915,7 @@ chatCommandP =
<|> ("! " <|> "!") *> (EditMessage <$> chatNameP <* A.space <*> (quotedMsg <|> pure "") <*> A.takeByteString)
<|> "/feed " *> (SendMessageBroadcast <$> A.takeByteString)
<|> ("/tail" <|> "/t") *> (LastMessages <$> optional (A.space *> chatNameP) <*> msgCountP)
<|> ("/file #" <|> "/f #") *> (SendGroupFile <$> displayName <* A.space <*> filePath)
<|> ("/file_v2 #" <|> "/f_v2 #") *> (SendGroupFileInv <$> displayName <* A.space <*> filePath)
<|> ("/file @" <|> "/file " <|> "/f @" <|> "/f ") *> (SendFile <$> displayName <* A.space <*> filePath)
<|> ("/file_v2 @" <|> "/file_v2 " <|> "/f_v2 @" <|> "/f_v2 ") *> (SendFileInv <$> displayName <* A.space <*> filePath)
<|> ("/file " <|> "/f ") *> (SendFile <$> chatNameP' <* A.space <*> filePath)
<|> ("/freceive " <|> "/fr ") *> (ReceiveFile <$> A.decimal <*> optional (A.space *> filePath))
<|> ("/fcancel " <|> "/fc ") *> (CancelFile <$> A.decimal)
<|> ("/fstatus " <|> "/fs ") *> (FileStatus <$> A.decimal)
@@ -2035,6 +1980,7 @@ chatCommandP =
<|> (" member" $> GRMember)
<|> pure GRAdmin
chatNameP = ChatName <$> chatTypeP <*> displayName
chatNameP' = ChatName <$> (chatTypeP <|> pure CTDirect) <*> displayName
chatRefP = ChatRef <$> chatTypeP <*> A.decimal
msgCountP = A.space *> A.decimal <|> pure 10
+1 -4
View File
@@ -145,10 +145,7 @@ data ChatCommand
| ListGroups
| SendGroupMessageQuote {groupName :: GroupName, contactName_ :: Maybe ContactName, quotedMsg :: ByteString, message :: ByteString}
| LastMessages (Maybe ChatName) Int
| SendFile ContactName FilePath
| SendFileInv ContactName FilePath
| SendGroupFile GroupName FilePath
| SendGroupFileInv GroupName FilePath
| SendFile ChatName FilePath
| ReceiveFile FileTransferId (Maybe FilePath)
| CancelFile FileTransferId
| FileStatus FileTransferId
-3
View File
@@ -46,9 +46,6 @@ runInputLoop ct cc = forever $ do
isMessage = \case
Right SendMessage {} -> True
Right SendFile {} -> True
Right SendFileInv {} -> True
Right SendGroupFile {} -> True
Right SendGroupFileInv {} -> True
Right SendMessageQuote {} -> True
Right SendGroupMessageQuote {} -> True
Right SendMessageBroadcast {} -> True
-147
View File
@@ -57,12 +57,6 @@ chatTests = do
it "sender cancelled file transfer" testFileSndCancel
it "recipient cancelled file transfer" testFileRcvCancel
it "send and receive file to group" testGroupFileTransfer
describe "sending and receiving files v2" $ do
it "send and receive file" testFileTransferV2
it "send and receive a small file" testSmallFileTransferV2
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
@@ -1064,134 +1058,6 @@ testGroupFileTransfer =
cath <## "use /fr 1 [<dir>/ | <path>] to receive it"
]
alice ##> "/fs 1"
getTermLine alice >>= (`shouldStartWith` "sending file 1 (test.jpg) not accepted")
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"
alice ##> "/fs 1"
alice <## "sending file 1 (test.jpg):"
alice <### [" complete: bob", " not accepted: cath"],
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"
alice ##> "/fs 1"
getTermLine alice >>= (`shouldStartWith` "sending file 1 (test.jpg) complete"),
do
cath <## "started receiving file 1 (test.jpg) from alice"
cath <## "completed receiving file 1 (test.jpg) from alice"
]
testFileTransferV2 :: IO ()
testFileTransferV2 =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
startFileTransferV2 alice bob
concurrentlyN_
[ do
bob #> "@alice receiving here..."
bob <## "completed receiving file 1 (test.jpg) from alice",
do
alice <# "bob> receiving here..."
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
testSmallFileTransferV2 :: IO ()
testSmallFileTransferV2 =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
alice `send` "/f_v2 @bob ./tests/fixtures/test.txt"
alice <# "/f @bob ./tests/fixtures/test.txt"
alice <## "use /fc 1 to cancel sending"
bob <# "alice> sends file test.txt (11 bytes / 11 bytes)"
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
bob ##> "/fr 1 ./tests/tmp"
bob <## "saving file 1 from alice to ./tests/tmp/test.txt"
concurrentlyN_
[ do
bob <## "started receiving file 1 (test.txt) from alice"
bob <## "completed receiving file 1 (test.txt) from alice",
do
alice <## "started sending file 1 (test.txt) to bob"
alice <## "completed sending file 1 (test.txt) to bob"
]
src <- B.readFile "./tests/fixtures/test.txt"
dest <- B.readFile "./tests/tmp/test.txt"
dest `shouldBe` src
testFileSndCancelV2 :: IO ()
testFileSndCancelV2 =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
startFileTransferV2 alice bob
alice ##> "/fc 1"
concurrentlyN_
[ do
alice <## "cancelled sending file 1 (test.jpg) to bob"
alice ##> "/fs 1"
alice <## "sending file 1 (test.jpg) cancelled: bob"
alice <## "file transfer cancelled",
do
bob <## "alice cancelled sending file 1 (test.jpg)"
bob ##> "/fs 1"
bob <## "receiving file 1 (test.jpg) cancelled, received part path: ./tests/tmp/test.jpg"
]
checkPartialTransfer
testFileRcvCancelV2 :: IO ()
testFileRcvCancelV2 =
testChat2 aliceProfile bobProfile $
\alice bob -> do
connectUsers alice bob
startFileTransferV2 alice bob
bob ##> "/fs 1"
getTermLine bob >>= (`shouldStartWith` "receiving file 1 (test.jpg) progress")
waitFileExists "./tests/tmp/test.jpg"
bob ##> "/fc 1"
concurrentlyN_
[ do
bob <## "cancelled receiving file 1 (test.jpg) from alice"
bob ##> "/fs 1"
bob <## "receiving file 1 (test.jpg) cancelled, received part path: ./tests/tmp/test.jpg",
do
alice <## "bob cancelled receiving file 1 (test.jpg)"
alice ##> "/fs 1"
alice <## "sending file 1 (test.jpg) cancelled: bob"
]
checkPartialTransfer
testGroupFileTransferV2 :: IO ()
testGroupFileTransferV2 =
testChat3 aliceProfile bobProfile cathProfile $
\alice bob cath -> do
createGroup3 "team" alice bob cath
alice `send` "/f_v2 #team ./tests/fixtures/test.jpg"
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 [<dir>/ | <path>] to receive it",
do
cath <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
cath <## "use /fr 1 [<dir>/ | <path>] to receive it"
]
alice ##> "/fs 1"
getTermLine alice >>= (`shouldStartWith` "sending file 1 (test.jpg): no file transfers")
bob ##> "/fr 1 ./tests/tmp/"
bob <## "saving file 1 from alice to ./tests/tmp/test.jpg"
@@ -1905,19 +1771,6 @@ startFileTransfer alice bob = do
(bob <## "started receiving file 1 (test.jpg) from alice")
(alice <## "started sending file 1 (test.jpg) to bob")
startFileTransferV2 :: TestCC -> TestCC -> IO ()
startFileTransferV2 alice bob = do
alice `send` "/f_v2 @bob ./tests/fixtures/test.jpg"
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 [<dir>/ | <path>] 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")
checkPartialTransfer :: IO ()
checkPartialTransfer = do
src <- B.readFile "./tests/fixtures/test.jpg"