mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2025-03-14 09:45:42 +00:00
621b291da1
* core: member mentions, types and rfc * update * update rfc * save/get mentions (WIP) * markdown * store received mentions and userMention flag * sent mentions * update message with mentions * db queries * CLI mentions, test passes * use maps for mentions * tests * comment * save mentions on sent messages * postresql schema * refactor * M.empty * include both displayName and localAlias into MentionedMemberInfo * fix saving sent mentions * include mentions in previews * update plans
1205 lines
53 KiB
Haskell
1205 lines
53 KiB
Haskell
{-# LANGUAGE DuplicateRecordFields #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE PostfixOperators #-}
|
|
{-# OPTIONS_GHC -fno-warn-ambiguous-fields #-}
|
|
|
|
module ChatTests.Files where
|
|
|
|
import ChatClient
|
|
import ChatTests.DBUtils
|
|
import ChatTests.Utils
|
|
import Control.Concurrent (threadDelay)
|
|
import Control.Concurrent.Async (concurrently_)
|
|
import Control.Logger.Simple
|
|
import qualified Data.Aeson as J
|
|
import qualified Data.ByteString.Char8 as B
|
|
import qualified Data.ByteString.Lazy.Char8 as LB
|
|
import Network.HTTP.Types.URI (urlEncode)
|
|
import Simplex.Chat.Controller (ChatConfig (..))
|
|
import Simplex.Chat.Library.Internal (roundedFDCount)
|
|
import Simplex.Chat.Mobile.File
|
|
import Simplex.Chat.Options (ChatOpts (..))
|
|
import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..))
|
|
import Simplex.Messaging.Crypto.File (CryptoFile (..), CryptoFileArgs (..))
|
|
import Simplex.Messaging.Encoding.String
|
|
import System.Directory (copyFile, createDirectoryIfMissing, doesFileExist, getFileSize)
|
|
import Test.Hspec hiding (it)
|
|
|
|
chatFileTests :: SpecWith TestParams
|
|
chatFileTests = do
|
|
describe "messages with files" $ do
|
|
it "send and receive message with file" runTestMessageWithFile
|
|
it "send and receive image" testSendImage
|
|
it "sender marking chat item deleted cancels file" testSenderMarkItemDeleted
|
|
it "files folder: send and receive image" testFilesFoldersSendImage
|
|
it "files folder: sender deleted file" testFilesFoldersImageSndDelete -- TODO add test deleting during upload
|
|
it "files folder: recipient deleted file" testFilesFoldersImageRcvDelete -- TODO add test deleting during download
|
|
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 "batch send messages with files" $ do
|
|
it "with files folder: send multiple files to contact" testSendMultiFilesDirect
|
|
it "with files folder: send multiple files to group" testSendMultiFilesGroup
|
|
describe "file transfer over XFTP" $ do
|
|
it "round file description count" $ const testXFTPRoundFDCount
|
|
it "send and receive file" testXFTPFileTransfer
|
|
it "send and receive locally encrypted files" testXFTPFileTransferEncrypted
|
|
it "send and receive file, accepting after upload" testXFTPAcceptAfterUpload
|
|
it "send and receive file in group" testXFTPGroupFileTransfer
|
|
it "delete uploaded file" testXFTPDeleteUploadedFile
|
|
it "delete uploaded file in group" testXFTPDeleteUploadedFileGroup
|
|
it "with relative paths: send and receive file" testXFTPWithRelativePaths
|
|
xit' "continue receiving file after restart" testXFTPContinueRcv
|
|
xit' "receive file marked to receive on chat start" testXFTPMarkToReceive
|
|
it "error receiving file" testXFTPRcvError
|
|
it "cancel receiving file, repeat receive" testXFTPCancelRcvRepeat
|
|
it "should accept file automatically with CLI option" testAutoAcceptFile
|
|
it "should prohibit file transfers in groups based on preference" testProhibitFiles
|
|
describe "file transfer over XFTP without chat items" $ do
|
|
it "send and receive small standalone file" testXFTPStandaloneSmall
|
|
it "send and receive small standalone file with extra information" testXFTPStandaloneSmallInfo
|
|
it "send and receive large standalone file" testXFTPStandaloneLarge
|
|
it "send and receive large standalone file with extra information" testXFTPStandaloneLargeInfo
|
|
it "send and receive large standalone file using relative paths" testXFTPStandaloneRelativePaths
|
|
xit "removes sent file from server" testXFTPStandaloneCancelSnd -- no error shown in tests
|
|
it "removes received temporary files" testXFTPStandaloneCancelRcv
|
|
|
|
runTestMessageWithFile :: HasCallStack => TestParams -> IO ()
|
|
runTestMessageWithFile = testChat2 aliceProfile bobProfile $ \alice bob -> withXFTPServer $ do
|
|
connectUsers alice bob
|
|
|
|
alice ##> "/_send @2 json [{\"filePath\": \"./tests/fixtures/test.jpg\", \"msgContent\": {\"type\": \"text\", \"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 [<dir>/ | <path>] to receive it"
|
|
alice <## "completed uploading file 1 (test.jpg) for bob"
|
|
|
|
bob ##> "/fr 1 ./tests/tmp"
|
|
bob
|
|
<### [ "saving file 1 from alice to ./tests/tmp/test.jpg",
|
|
"started receiving file 1 (test.jpg) from alice"
|
|
]
|
|
bob <## "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
|
|
alice #$> ("/_get chat @2 count=100", chatF, chatFeaturesF <> [((1, "hi, sending a file"), Just "./tests/fixtures/test.jpg")])
|
|
bob #$> ("/_get chat @2 count=100", chatF, chatFeaturesF <> [((0, "hi, sending a file"), Just "./tests/tmp/test.jpg")])
|
|
|
|
testSendImage :: HasCallStack => TestParams -> IO ()
|
|
testSendImage =
|
|
testChat2 aliceProfile bobProfile $
|
|
\alice bob -> withXFTPServer $ do
|
|
connectUsers alice bob
|
|
alice ##> "/_send @2 json [{\"filePath\": \"./tests/fixtures/test.jpg\", \"msgContent\": {\"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 [<dir>/ | <path>] to receive it"
|
|
alice <## "completed uploading file 1 (test.jpg) for bob"
|
|
|
|
bob ##> "/fr 1 ./tests/tmp"
|
|
bob
|
|
<### [ "saving file 1 from alice to ./tests/tmp/test.jpg",
|
|
"started receiving file 1 (test.jpg) from alice"
|
|
]
|
|
bob <## "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
|
|
alice #$> ("/_get chat @2 count=100", chatF, chatFeaturesF <> [((1, ""), Just "./tests/fixtures/test.jpg")])
|
|
bob #$> ("/_get chat @2 count=100", chatF, chatFeaturesF <> [((0, ""), Just "./tests/tmp/test.jpg")])
|
|
-- deleting contact without files folder set should not remove file
|
|
bob ##> "/d alice"
|
|
bob <## "alice: contact is deleted"
|
|
alice <## "bob (Bob) deleted contact with you"
|
|
fileExists <- doesFileExist "./tests/tmp/test.jpg"
|
|
fileExists `shouldBe` True
|
|
|
|
testSenderMarkItemDeleted :: HasCallStack => TestParams -> IO ()
|
|
testSenderMarkItemDeleted =
|
|
testChat2 aliceProfile bobProfile $
|
|
\alice bob -> withXFTPServer $ do
|
|
connectUsers alice bob
|
|
alice ##> "/_send @2 json [{\"filePath\": \"./tests/fixtures/test_1MB.pdf\", \"msgContent\": {\"type\": \"text\", \"text\": \"hi, sending a file\"}}]"
|
|
alice <# "@bob hi, sending a file"
|
|
alice <# "/f @bob ./tests/fixtures/test_1MB.pdf"
|
|
alice <## "use /fc 1 to cancel sending"
|
|
bob <# "alice> hi, sending a file"
|
|
bob <# "alice> sends file test_1MB.pdf (1017.7 KiB / 1042157 bytes)"
|
|
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
|
alice <## "completed uploading file 1 (test_1MB.pdf) for bob"
|
|
|
|
alice #$> ("/_delete item @2 " <> itemId 1 <> " broadcast", id, "message marked deleted")
|
|
bob <# "alice> [marked deleted] hi, sending a file"
|
|
|
|
bob ##> "/fr 1 ./tests/tmp"
|
|
bob <## "file cancelled: test_1MB.pdf"
|
|
|
|
bob ##> "/fs 1"
|
|
bob <## "receiving file 1 (test_1MB.pdf) cancelled"
|
|
|
|
testFilesFoldersSendImage :: HasCallStack => TestParams -> IO ()
|
|
testFilesFoldersSendImage =
|
|
testChat2 aliceProfile bobProfile $
|
|
\alice bob -> withXFTPServer $ do
|
|
connectUsers alice bob
|
|
alice #$> ("/_files_folder ./tests/fixtures", id, "ok")
|
|
bob #$> ("/_files_folder ./tests/tmp/app_files", id, "ok")
|
|
alice ##> "/_send @2 json [{\"filePath\": \"test.jpg\", \"msgContent\": {\"text\":\"\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}]"
|
|
alice <# "/f @bob 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"
|
|
alice <## "completed uploading file 1 (test.jpg) for bob"
|
|
|
|
bob ##> "/fr 1"
|
|
bob
|
|
<### [ "saving file 1 from alice to test.jpg",
|
|
"started receiving file 1 (test.jpg) from alice"
|
|
]
|
|
bob <## "completed receiving file 1 (test.jpg) from alice"
|
|
|
|
src <- B.readFile "./tests/fixtures/test.jpg"
|
|
dest <- B.readFile "./tests/tmp/app_files/test.jpg"
|
|
dest `shouldBe` src
|
|
alice #$> ("/_get chat @2 count=100", chatF, chatFeaturesF <> [((1, ""), Just "test.jpg")])
|
|
bob #$> ("/_get chat @2 count=100", chatF, chatFeaturesF <> [((0, ""), Just "test.jpg")])
|
|
-- deleting contact with files folder set should remove file
|
|
checkActionDeletesFile "./tests/tmp/app_files/test.jpg" $ do
|
|
bob ##> "/d alice"
|
|
bob <## "alice: contact is deleted"
|
|
alice <## "bob (Bob) deleted contact with you"
|
|
|
|
testFilesFoldersImageSndDelete :: HasCallStack => TestParams -> IO ()
|
|
testFilesFoldersImageSndDelete =
|
|
testChat2 aliceProfile bobProfile $
|
|
\alice bob -> withXFTPServer $ do
|
|
connectUsers alice bob
|
|
alice #$> ("/_files_folder ./tests/tmp/alice_app_files", id, "ok")
|
|
copyFile "./tests/fixtures/test_1MB.pdf" "./tests/tmp/alice_app_files/test_1MB.pdf"
|
|
bob #$> ("/_files_folder ./tests/tmp/bob_app_files", id, "ok")
|
|
alice ##> "/_send @2 json [{\"filePath\": \"test_1MB.pdf\", \"msgContent\": {\"text\":\"\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}]"
|
|
alice <# "/f @bob test_1MB.pdf"
|
|
alice <## "use /fc 1 to cancel sending"
|
|
bob <# "alice> sends file test_1MB.pdf (1017.7 KiB / 1042157 bytes)"
|
|
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
|
alice <## "completed uploading file 1 (test_1MB.pdf) for bob"
|
|
|
|
bob ##> "/fr 1"
|
|
bob
|
|
<### [ "saving file 1 from alice to test_1MB.pdf",
|
|
"started receiving file 1 (test_1MB.pdf) from alice"
|
|
]
|
|
bob <## "completed receiving file 1 (test_1MB.pdf) from alice"
|
|
|
|
-- deleting contact should remove file
|
|
checkActionDeletesFile "./tests/tmp/alice_app_files/test_1MB.pdf" $ do
|
|
alice ##> "/d bob"
|
|
alice <## "bob: contact is deleted"
|
|
bob <## "alice (Alice) deleted contact with you"
|
|
bob ##> "/fs 1"
|
|
bob <##. "receiving file 1 (test_1MB.pdf) complete"
|
|
checkActionDeletesFile "./tests/tmp/bob_app_files/test_1MB.pdf" $ do
|
|
bob ##> "/d alice"
|
|
bob <## "alice: contact is deleted"
|
|
|
|
testFilesFoldersImageRcvDelete :: HasCallStack => TestParams -> IO ()
|
|
testFilesFoldersImageRcvDelete =
|
|
testChat2 aliceProfile bobProfile $
|
|
\alice bob -> withXFTPServer $ do
|
|
connectUsers alice bob
|
|
alice #$> ("/_files_folder ./tests/fixtures", id, "ok")
|
|
bob #$> ("/_files_folder ./tests/tmp/app_files", id, "ok")
|
|
alice ##> "/_send @2 json [{\"filePath\": \"test.jpg\", \"msgContent\": {\"text\":\"\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}]"
|
|
alice <# "/f @bob 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"
|
|
alice <## "completed uploading file 1 (test.jpg) for bob"
|
|
|
|
bob ##> "/fr 1"
|
|
bob
|
|
<### [ "saving file 1 from alice to test.jpg",
|
|
"started receiving file 1 (test.jpg) from alice"
|
|
]
|
|
bob <## "completed receiving file 1 (test.jpg) from alice"
|
|
|
|
-- deleting contact should remove file
|
|
checkActionDeletesFile "./tests/tmp/app_files/test.jpg" $ do
|
|
bob ##> "/d alice"
|
|
bob <## "alice: contact is deleted"
|
|
alice <## "bob (Bob) deleted contact with you"
|
|
|
|
testSendImageWithTextAndQuote :: HasCallStack => TestParams -> IO ()
|
|
testSendImageWithTextAndQuote =
|
|
testChat2 aliceProfile bobProfile $
|
|
\alice bob -> withXFTPServer $ do
|
|
connectUsers alice bob
|
|
bob #> "@alice hi alice"
|
|
alice <# "bob> hi alice"
|
|
alice ##> ("/_send @2 json [{\"filePath\": \"./tests/fixtures/test.jpg\", \"quotedItemId\": " <> itemId 1 <> ", \"msgContent\": {\"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 [<dir>/ | <path>] to receive it"
|
|
alice <## "completed uploading file 1 (test.jpg) for bob"
|
|
|
|
bob ##> "/fr 1 ./tests/tmp"
|
|
bob
|
|
<### [ "saving file 1 from alice to ./tests/tmp/test.jpg",
|
|
"started receiving file 1 (test.jpg) from alice"
|
|
]
|
|
bob <## "completed receiving file 1 (test.jpg) from alice"
|
|
|
|
src <- B.readFile "./tests/fixtures/test.jpg"
|
|
B.readFile "./tests/tmp/test.jpg" `shouldReturn` src
|
|
alice #$> ("/_get chat @2 count=100", chat'', chatFeatures'' <> [((0, "hi alice"), Nothing, Nothing), ((1, "hey bob"), Just (0, "hi alice"), Just "./tests/fixtures/test.jpg")])
|
|
alice @@@ [("@bob", "hey bob")]
|
|
bob #$> ("/_get chat @2 count=100", chat'', chatFeatures'' <> [((1, "hi alice"), Nothing, Nothing), ((0, "hey bob"), Just (1, "hi alice"), Just "./tests/tmp/test.jpg")])
|
|
bob @@@ [("@alice", "hey bob")]
|
|
|
|
-- quoting (file + text) with file uses quoted text
|
|
bob ##> ("/_send @2 json [{\"filePath\": \"./tests/fixtures/test.pdf\", \"quotedItemId\": " <> itemId 2 <> ", \"msgContent\": {\"text\":\"\",\"type\":\"file\"}}]")
|
|
bob <# "@alice > hey bob"
|
|
bob <## " test.pdf"
|
|
bob <# "/f @alice ./tests/fixtures/test.pdf"
|
|
bob <## "use /fc 2 to cancel sending"
|
|
alice <# "bob> > hey bob"
|
|
alice <## " test.pdf"
|
|
alice <# "bob> sends file test.pdf (266.0 KiB / 272376 bytes)"
|
|
alice <## "use /fr 2 [<dir>/ | <path>] to receive it"
|
|
bob <## "completed uploading file 2 (test.pdf) for alice"
|
|
|
|
alice ##> "/fr 2 ./tests/tmp"
|
|
alice
|
|
<### [ "saving file 2 from bob to ./tests/tmp/test.pdf",
|
|
"started receiving file 2 (test.pdf) from bob"
|
|
]
|
|
alice <## "completed receiving file 2 (test.pdf) from bob"
|
|
|
|
txtSrc <- B.readFile "./tests/fixtures/test.pdf"
|
|
B.readFile "./tests/tmp/test.pdf" `shouldReturn` txtSrc
|
|
|
|
-- quoting (file without text) with file uses file name
|
|
alice ##> ("/_send @2 json [{\"filePath\": \"./tests/fixtures/test.jpg\", \"quotedItemId\": " <> itemId 3 <> ", \"msgContent\": {\"text\":\"\",\"type\":\"image\",\"image\":\"data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAgAAAAIAQMAAAD+wSzIAAAABlBMVEX///+/v7+jQ3Y5AAAADklEQVQI12P4AIX8EAgALgAD/aNpbtEAAAAASUVORK5CYII=\"}}]")
|
|
alice <# "@bob > test.pdf"
|
|
alice <## " test.jpg"
|
|
alice <# "/f @bob ./tests/fixtures/test.jpg"
|
|
alice <## "use /fc 3 to cancel sending"
|
|
bob <# "alice> > test.pdf"
|
|
bob <## " test.jpg"
|
|
bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
|
|
bob <## "use /fr 3 [<dir>/ | <path>] to receive it"
|
|
alice <## "completed uploading file 3 (test.jpg) for bob"
|
|
|
|
bob ##> "/fr 3 ./tests/tmp"
|
|
bob
|
|
<### [ "saving file 3 from alice to ./tests/tmp/test_1.jpg",
|
|
"started receiving file 3 (test.jpg) from alice"
|
|
]
|
|
bob <## "completed receiving file 3 (test.jpg) from alice"
|
|
|
|
B.readFile "./tests/tmp/test_1.jpg" `shouldReturn` src
|
|
|
|
testGroupSendImage :: HasCallStack => TestParams -> IO ()
|
|
testGroupSendImage =
|
|
testChat3 aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> withXFTPServer $ do
|
|
createGroup3 "team" alice bob cath
|
|
threadDelay 1000000
|
|
alice ##> "/_send #1 json [{\"filePath\": \"./tests/fixtures/test.jpg\", \"msgContent\": {\"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 [<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 <## "completed uploading file 1 (test.jpg) for #team"
|
|
|
|
bob ##> "/fr 1 ./tests/tmp"
|
|
bob
|
|
<### [ "saving file 1 from alice to ./tests/tmp/test.jpg",
|
|
"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",
|
|
"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=1", chatF, [((1, ""), Just "./tests/fixtures/test.jpg")])
|
|
bob #$> ("/_get chat #1 count=1", chatF, [((0, ""), Just "./tests/tmp/test.jpg")])
|
|
cath #$> ("/_get chat #1 count=1", chatF, [((0, ""), Just "./tests/tmp/test_1.jpg")])
|
|
|
|
testGroupSendImageWithTextAndQuote :: HasCallStack => TestParams -> IO ()
|
|
testGroupSendImageWithTextAndQuote =
|
|
testChat3 aliceProfile bobProfile cathProfile $
|
|
\alice bob cath -> withXFTPServer $ do
|
|
createGroup3 "team" alice bob cath
|
|
threadDelay 1000000
|
|
bob #> "#team hi team"
|
|
concurrently_
|
|
(alice <# "#team bob> hi team")
|
|
(cath <# "#team bob> hi team")
|
|
threadDelay 1000000
|
|
msgItemId <- lastItemId alice
|
|
alice ##> ("/_send #1 json [{\"filePath\": \"./tests/fixtures/test.jpg\", \"quotedItemId\": " <> msgItemId <> ", \"msgContent\": {\"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 [<dir>/ | <path>] 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 [<dir>/ | <path>] to receive it"
|
|
]
|
|
alice <## "completed uploading file 1 (test.jpg) for #team"
|
|
|
|
bob ##> "/fr 1 ./tests/tmp"
|
|
bob
|
|
<### [ "saving file 1 from alice to ./tests/tmp/test.jpg",
|
|
"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",
|
|
"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=2", chat'', [((0, "hi team"), Nothing, Nothing), ((1, "hey bob"), Just (0, "hi team"), Just "./tests/fixtures/test.jpg")])
|
|
alice @@@ [("#team", "hey bob"), ("@bob", "sent invitation to join group team as admin"), ("@cath", "sent invitation to join group team as admin")]
|
|
bob #$> ("/_get chat #1 count=2", chat'', [((1, "hi team"), Nothing, Nothing), ((0, "hey bob"), Just (1, "hi team"), Just "./tests/tmp/test.jpg")])
|
|
bob @@@ [("#team", "hey bob"), ("@alice", "received invitation to join group team as admin")]
|
|
cath #$> ("/_get chat #1 count=2", chat'', [((0, "hi team"), Nothing, Nothing), ((0, "hey bob"), Just (0, "hi team"), Just "./tests/tmp/test_1.jpg")])
|
|
cath @@@ [("#team", "hey bob"), ("@alice", "received invitation to join group team as admin")]
|
|
|
|
testSendMultiFilesDirect :: HasCallStack => TestParams -> IO ()
|
|
testSendMultiFilesDirect =
|
|
testChat2 aliceProfile bobProfile $ \alice bob -> do
|
|
withXFTPServer $ do
|
|
connectUsers alice bob
|
|
|
|
alice #$> ("/_files_folder ./tests/tmp/alice_app_files", id, "ok")
|
|
copyFile "./tests/fixtures/test.jpg" "./tests/tmp/alice_app_files/test.jpg"
|
|
copyFile "./tests/fixtures/test.pdf" "./tests/tmp/alice_app_files/test.pdf"
|
|
bob #$> ("/_files_folder ./tests/tmp/bob_app_files", id, "ok")
|
|
|
|
let cm1 = "{\"msgContent\": {\"type\": \"text\", \"text\": \"message without file\"}}"
|
|
cm2 = "{\"filePath\": \"test.jpg\", \"msgContent\": {\"type\": \"text\", \"text\": \"sending file 1\"}}"
|
|
cm3 = "{\"filePath\": \"test.pdf\", \"msgContent\": {\"type\": \"text\", \"text\": \"sending file 2\"}}"
|
|
alice ##> ("/_send @2 json [" <> cm1 <> "," <> cm2 <> "," <> cm3 <> "]")
|
|
|
|
alice <# "@bob message without file"
|
|
|
|
alice <# "@bob sending file 1"
|
|
alice <# "/f @bob test.jpg"
|
|
alice <## "use /fc 1 to cancel sending"
|
|
|
|
alice <# "@bob sending file 2"
|
|
alice <# "/f @bob test.pdf"
|
|
alice <## "use /fc 2 to cancel sending"
|
|
|
|
bob <# "alice> message without file"
|
|
|
|
bob <# "alice> sending file 1"
|
|
bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
|
|
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
|
|
|
bob <# "alice> sending file 2"
|
|
bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)"
|
|
bob <## "use /fr 2 [<dir>/ | <path>] to receive it"
|
|
|
|
alice <## "completed uploading file 1 (test.jpg) for bob"
|
|
alice <## "completed uploading file 2 (test.pdf) for bob"
|
|
|
|
bob ##> "/fr 1"
|
|
bob
|
|
<### [ "saving file 1 from alice to test.jpg",
|
|
"started receiving file 1 (test.jpg) from alice"
|
|
]
|
|
bob <## "completed receiving file 1 (test.jpg) from alice"
|
|
|
|
bob ##> "/fr 2"
|
|
bob
|
|
<### [ "saving file 2 from alice to test.pdf",
|
|
"started receiving file 2 (test.pdf) from alice"
|
|
]
|
|
bob <## "completed receiving file 2 (test.pdf) from alice"
|
|
|
|
src1 <- B.readFile "./tests/tmp/alice_app_files/test.jpg"
|
|
dest1 <- B.readFile "./tests/tmp/bob_app_files/test.jpg"
|
|
dest1 `shouldBe` src1
|
|
|
|
src2 <- B.readFile "./tests/tmp/alice_app_files/test.pdf"
|
|
dest2 <- B.readFile "./tests/tmp/bob_app_files/test.pdf"
|
|
dest2 `shouldBe` src2
|
|
|
|
alice #$> ("/_get chat @2 count=3", chatF, [((1, "message without file"), Nothing), ((1, "sending file 1"), Just "test.jpg"), ((1, "sending file 2"), Just "test.pdf")])
|
|
bob #$> ("/_get chat @2 count=3", chatF, [((0, "message without file"), Nothing), ((0, "sending file 1"), Just "test.jpg"), ((0, "sending file 2"), Just "test.pdf")])
|
|
|
|
testSendMultiFilesGroup :: HasCallStack => TestParams -> IO ()
|
|
testSendMultiFilesGroup =
|
|
testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
|
|
withXFTPServer $ do
|
|
createGroup3 "team" alice bob cath
|
|
|
|
threadDelay 1000000
|
|
|
|
alice #$> ("/_files_folder ./tests/tmp/alice_app_files", id, "ok")
|
|
copyFile "./tests/fixtures/test.jpg" "./tests/tmp/alice_app_files/test.jpg"
|
|
copyFile "./tests/fixtures/test.pdf" "./tests/tmp/alice_app_files/test.pdf"
|
|
bob #$> ("/_files_folder ./tests/tmp/bob_app_files", id, "ok")
|
|
cath #$> ("/_files_folder ./tests/tmp/cath_app_files", id, "ok")
|
|
|
|
let cm1 = "{\"msgContent\": {\"type\": \"text\", \"text\": \"message without file\"}}"
|
|
cm2 = "{\"filePath\": \"test.jpg\", \"msgContent\": {\"type\": \"text\", \"text\": \"sending file 1\"}}"
|
|
cm3 = "{\"filePath\": \"test.pdf\", \"msgContent\": {\"type\": \"text\", \"text\": \"sending file 2\"}}"
|
|
alice ##> ("/_send #1 json [" <> cm1 <> "," <> cm2 <> "," <> cm3 <> "]")
|
|
|
|
alice <# "#team message without file"
|
|
|
|
alice <# "#team sending file 1"
|
|
alice <# "/f #team test.jpg"
|
|
alice <## "use /fc 1 to cancel sending"
|
|
|
|
alice <# "#team sending file 2"
|
|
alice <# "/f #team test.pdf"
|
|
alice <## "use /fc 2 to cancel sending"
|
|
|
|
bob <# "#team alice> message without file"
|
|
|
|
bob <# "#team alice> sending file 1"
|
|
bob <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
|
|
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
|
|
|
bob <# "#team alice> sending file 2"
|
|
bob <# "#team alice> sends file test.pdf (266.0 KiB / 272376 bytes)"
|
|
bob <## "use /fr 2 [<dir>/ | <path>] to receive it"
|
|
|
|
cath <# "#team alice> message without file"
|
|
|
|
cath <# "#team alice> sending file 1"
|
|
cath <# "#team alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
|
|
cath <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
|
|
|
cath <# "#team alice> sending file 2"
|
|
cath <# "#team alice> sends file test.pdf (266.0 KiB / 272376 bytes)"
|
|
cath <## "use /fr 2 [<dir>/ | <path>] to receive it"
|
|
|
|
alice <## "completed uploading file 1 (test.jpg) for #team"
|
|
alice <## "completed uploading file 2 (test.pdf) for #team"
|
|
|
|
bob ##> "/fr 1"
|
|
bob
|
|
<### [ "saving file 1 from alice to test.jpg",
|
|
"started receiving file 1 (test.jpg) from alice"
|
|
]
|
|
bob <## "completed receiving file 1 (test.jpg) from alice"
|
|
|
|
bob ##> "/fr 2"
|
|
bob
|
|
<### [ "saving file 2 from alice to test.pdf",
|
|
"started receiving file 2 (test.pdf) from alice"
|
|
]
|
|
bob <## "completed receiving file 2 (test.pdf) from alice"
|
|
|
|
cath ##> "/fr 1"
|
|
cath
|
|
<### [ "saving file 1 from alice to test.jpg",
|
|
"started receiving file 1 (test.jpg) from alice"
|
|
]
|
|
cath <## "completed receiving file 1 (test.jpg) from alice"
|
|
|
|
cath ##> "/fr 2"
|
|
cath
|
|
<### [ "saving file 2 from alice to test.pdf",
|
|
"started receiving file 2 (test.pdf) from alice"
|
|
]
|
|
cath <## "completed receiving file 2 (test.pdf) from alice"
|
|
|
|
src1 <- B.readFile "./tests/tmp/alice_app_files/test.jpg"
|
|
dest1_1 <- B.readFile "./tests/tmp/bob_app_files/test.jpg"
|
|
dest1_2 <- B.readFile "./tests/tmp/cath_app_files/test.jpg"
|
|
dest1_1 `shouldBe` src1
|
|
dest1_2 `shouldBe` src1
|
|
|
|
src2 <- B.readFile "./tests/tmp/alice_app_files/test.pdf"
|
|
dest2_1 <- B.readFile "./tests/tmp/bob_app_files/test.pdf"
|
|
dest2_2 <- B.readFile "./tests/tmp/cath_app_files/test.pdf"
|
|
dest2_1 `shouldBe` src2
|
|
dest2_2 `shouldBe` src2
|
|
|
|
alice #$> ("/_get chat #1 count=3", chatF, [((1, "message without file"), Nothing), ((1, "sending file 1"), Just "test.jpg"), ((1, "sending file 2"), Just "test.pdf")])
|
|
bob #$> ("/_get chat #1 count=3", chatF, [((0, "message without file"), Nothing), ((0, "sending file 1"), Just "test.jpg"), ((0, "sending file 2"), Just "test.pdf")])
|
|
cath #$> ("/_get chat #1 count=3", chatF, [((0, "message without file"), Nothing), ((0, "sending file 1"), Just "test.jpg"), ((0, "sending file 2"), Just "test.pdf")])
|
|
|
|
testXFTPRoundFDCount :: Expectation
|
|
testXFTPRoundFDCount = do
|
|
roundedFDCount (-100) `shouldBe` 4
|
|
roundedFDCount (-1) `shouldBe` 4
|
|
roundedFDCount 0 `shouldBe` 4
|
|
roundedFDCount 1 `shouldBe` 4
|
|
roundedFDCount 2 `shouldBe` 4
|
|
roundedFDCount 4 `shouldBe` 4
|
|
roundedFDCount 5 `shouldBe` 8
|
|
roundedFDCount 20 `shouldBe` 32
|
|
roundedFDCount 128 `shouldBe` 128
|
|
roundedFDCount 500 `shouldBe` 512
|
|
|
|
testXFTPFileTransfer :: HasCallStack => TestParams -> IO ()
|
|
testXFTPFileTransfer =
|
|
testChat2 aliceProfile bobProfile $ \alice bob -> do
|
|
withXFTPServer $ do
|
|
connectUsers alice bob
|
|
|
|
alice #> "/f @bob ./tests/fixtures/test.pdf"
|
|
alice <## "use /fc 1 to cancel sending"
|
|
bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)"
|
|
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
|
bob ##> "/fr 1 ./tests/tmp"
|
|
concurrentlyN_
|
|
[ alice <## "completed uploading file 1 (test.pdf) for bob",
|
|
bob
|
|
<### [ "saving file 1 from alice to ./tests/tmp/test.pdf",
|
|
"started receiving file 1 (test.pdf) from alice"
|
|
]
|
|
]
|
|
bob <## "completed receiving file 1 (test.pdf) from alice"
|
|
|
|
alice ##> "/fs 1"
|
|
alice <## "sending file 1 (test.pdf) complete"
|
|
bob ##> "/fs 1"
|
|
bob <## "receiving file 1 (test.pdf) complete, path: ./tests/tmp/test.pdf"
|
|
|
|
src <- B.readFile "./tests/fixtures/test.pdf"
|
|
dest <- B.readFile "./tests/tmp/test.pdf"
|
|
dest `shouldBe` src
|
|
|
|
testXFTPFileTransferEncrypted :: HasCallStack => TestParams -> IO ()
|
|
testXFTPFileTransferEncrypted =
|
|
testChat2 aliceProfile bobProfile $ \alice bob -> do
|
|
src <- B.readFile "./tests/fixtures/test.pdf"
|
|
srcLen <- getFileSize "./tests/fixtures/test.pdf"
|
|
let srcPath = "./tests/tmp/alice/test.pdf"
|
|
createDirectoryIfMissing True "./tests/tmp/alice/"
|
|
createDirectoryIfMissing True "./tests/tmp/bob/"
|
|
WFResult cfArgs <- chatWriteFile (chatController alice) srcPath src
|
|
let fileJSON = LB.unpack $ J.encode $ CryptoFile srcPath $ Just cfArgs
|
|
withXFTPServer $ do
|
|
connectUsers alice bob
|
|
alice ##> ("/_send @2 json [{\"msgContent\":{\"type\":\"file\", \"text\":\"\"}, \"fileSource\": " <> fileJSON <> "}]")
|
|
alice <# "/f @bob ./tests/tmp/alice/test.pdf"
|
|
alice <## "use /fc 1 to cancel sending"
|
|
bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)"
|
|
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
|
bob ##> "/fr 1 encrypt=on ./tests/tmp/bob/"
|
|
bob <## "saving file 1 from alice to ./tests/tmp/bob/test.pdf"
|
|
alice <## "completed uploading file 1 (test.pdf) for bob"
|
|
bob <## "started receiving file 1 (test.pdf) from alice"
|
|
bob <## "completed receiving file 1 (test.pdf) from alice"
|
|
Just (CFArgs key nonce) <- J.decode . LB.pack <$> getTermLine bob
|
|
Right dest <- chatReadFile "./tests/tmp/bob/test.pdf" (strEncode key) (strEncode nonce)
|
|
LB.length dest `shouldBe` fromIntegral srcLen
|
|
LB.toStrict dest `shouldBe` src
|
|
|
|
testXFTPAcceptAfterUpload :: HasCallStack => TestParams -> IO ()
|
|
testXFTPAcceptAfterUpload =
|
|
testChat2 aliceProfile bobProfile $ \alice bob -> do
|
|
withXFTPServer $ do
|
|
connectUsers alice bob
|
|
|
|
alice #> "/f @bob ./tests/fixtures/test.pdf"
|
|
alice <## "use /fc 1 to cancel sending"
|
|
bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)"
|
|
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
|
alice <## "completed uploading file 1 (test.pdf) for bob"
|
|
|
|
threadDelay 100000
|
|
|
|
bob ##> "/fr 1 ./tests/tmp"
|
|
bob
|
|
<### [ "saving file 1 from alice to ./tests/tmp/test.pdf",
|
|
"started receiving file 1 (test.pdf) from alice"
|
|
]
|
|
bob <## "completed receiving file 1 (test.pdf) from alice"
|
|
|
|
src <- B.readFile "./tests/fixtures/test.pdf"
|
|
dest <- B.readFile "./tests/tmp/test.pdf"
|
|
dest `shouldBe` src
|
|
|
|
testXFTPGroupFileTransfer :: HasCallStack => TestParams -> IO ()
|
|
testXFTPGroupFileTransfer =
|
|
testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
|
|
withXFTPServer $ do
|
|
createGroup3 "team" alice bob cath
|
|
|
|
alice #> "/f #team ./tests/fixtures/test.pdf"
|
|
alice <## "use /fc 1 to cancel sending"
|
|
concurrentlyN_
|
|
[ do
|
|
bob <# "#team alice> sends file test.pdf (266.0 KiB / 272376 bytes)"
|
|
bob <## "use /fr 1 [<dir>/ | <path>] to receive it",
|
|
do
|
|
cath <# "#team alice> sends file test.pdf (266.0 KiB / 272376 bytes)"
|
|
cath <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
|
]
|
|
alice <## "completed uploading file 1 (test.pdf) for #team"
|
|
|
|
bob ##> "/fr 1 ./tests/tmp"
|
|
bob
|
|
<### [ "saving file 1 from alice to ./tests/tmp/test.pdf",
|
|
"started receiving file 1 (test.pdf) from alice"
|
|
]
|
|
bob <## "completed receiving file 1 (test.pdf) from alice"
|
|
|
|
cath ##> "/fr 1 ./tests/tmp"
|
|
cath
|
|
<### [ "saving file 1 from alice to ./tests/tmp/test_1.pdf",
|
|
"started receiving file 1 (test.pdf) from alice"
|
|
]
|
|
cath <## "completed receiving file 1 (test.pdf) from alice"
|
|
|
|
src <- B.readFile "./tests/fixtures/test.pdf"
|
|
dest1 <- B.readFile "./tests/tmp/test.pdf"
|
|
dest2 <- B.readFile "./tests/tmp/test_1.pdf"
|
|
dest1 `shouldBe` src
|
|
dest2 `shouldBe` src
|
|
|
|
testXFTPDeleteUploadedFile :: HasCallStack => TestParams -> IO ()
|
|
testXFTPDeleteUploadedFile =
|
|
testChat2 aliceProfile bobProfile $ \alice bob -> do
|
|
withXFTPServer $ do
|
|
connectUsers alice bob
|
|
|
|
alice #> "/f @bob ./tests/fixtures/test.pdf"
|
|
alice <## "use /fc 1 to cancel sending"
|
|
bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)"
|
|
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
|
alice <## "completed uploading file 1 (test.pdf) for bob"
|
|
|
|
alice ##> "/fc 1"
|
|
concurrentlyN_
|
|
[ alice <## "cancelled sending file 1 (test.pdf)",
|
|
bob <## "alice cancelled sending file 1 (test.pdf)"
|
|
]
|
|
|
|
bob ##> "/fr 1 ./tests/tmp"
|
|
bob <## "file cancelled: test.pdf"
|
|
|
|
testXFTPDeleteUploadedFileGroup :: HasCallStack => TestParams -> IO ()
|
|
testXFTPDeleteUploadedFileGroup =
|
|
testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> do
|
|
withXFTPServer $ do
|
|
createGroup3 "team" alice bob cath
|
|
|
|
alice #> "/f #team ./tests/fixtures/test.pdf"
|
|
alice <## "use /fc 1 to cancel sending"
|
|
concurrentlyN_
|
|
[ do
|
|
bob <# "#team alice> sends file test.pdf (266.0 KiB / 272376 bytes)"
|
|
bob <## "use /fr 1 [<dir>/ | <path>] to receive it",
|
|
do
|
|
cath <# "#team alice> sends file test.pdf (266.0 KiB / 272376 bytes)"
|
|
cath <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
|
]
|
|
alice <## "completed uploading file 1 (test.pdf) for #team"
|
|
|
|
bob ##> "/fr 1 ./tests/tmp"
|
|
bob
|
|
<### [ "saving file 1 from alice to ./tests/tmp/test.pdf",
|
|
"started receiving file 1 (test.pdf) from alice"
|
|
]
|
|
bob <## "completed receiving file 1 (test.pdf) from alice"
|
|
|
|
alice ##> "/fs 1"
|
|
alice <## "sending file 1 (test.pdf) complete"
|
|
bob ##> "/fs 1"
|
|
bob <## "receiving file 1 (test.pdf) complete, path: ./tests/tmp/test.pdf"
|
|
cath ##> "/fs 1"
|
|
cath <## "receiving file 1 (test.pdf) not accepted yet, use /fr 1 to receive file"
|
|
|
|
src <- B.readFile "./tests/fixtures/test.pdf"
|
|
dest <- B.readFile "./tests/tmp/test.pdf"
|
|
dest `shouldBe` src
|
|
|
|
alice ##> "/fc 1"
|
|
concurrentlyN_
|
|
[ alice <## "cancelled sending file 1 (test.pdf) to bob, cath",
|
|
cath <## "alice cancelled sending file 1 (test.pdf)"
|
|
]
|
|
|
|
alice ##> "/fs 1"
|
|
alice <## "sending file 1 (test.pdf) cancelled"
|
|
bob ##> "/fs 1"
|
|
bob <## "receiving file 1 (test.pdf) complete, path: ./tests/tmp/test.pdf"
|
|
cath ##> "/fs 1"
|
|
cath <## "receiving file 1 (test.pdf) cancelled"
|
|
|
|
cath ##> "/fr 1 ./tests/tmp"
|
|
cath <## "file cancelled: test.pdf"
|
|
|
|
testXFTPWithRelativePaths :: HasCallStack => TestParams -> IO ()
|
|
testXFTPWithRelativePaths =
|
|
testChat2 aliceProfile bobProfile $ \alice bob -> do
|
|
withXFTPServer $ do
|
|
-- agent is passed xftp work directory only on chat start,
|
|
-- so for test we work around by stopping and starting chat
|
|
setRelativePaths alice "./tests/fixtures" "./tests/tmp/alice_xftp"
|
|
setRelativePaths bob "./tests/tmp/bob_files" "./tests/tmp/bob_xftp"
|
|
connectUsers alice bob
|
|
|
|
alice #> "/f @bob test.pdf"
|
|
alice <## "use /fc 1 to cancel sending"
|
|
bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)"
|
|
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
|
bob ##> "/fr 1"
|
|
concurrentlyN_
|
|
[ alice <## "completed uploading file 1 (test.pdf) for bob",
|
|
bob
|
|
<### [ "saving file 1 from alice to test.pdf",
|
|
"started receiving file 1 (test.pdf) from alice"
|
|
]
|
|
]
|
|
bob <## "completed receiving file 1 (test.pdf) from alice"
|
|
|
|
src <- B.readFile "./tests/fixtures/test.pdf"
|
|
dest <- B.readFile "./tests/tmp/bob_files/test.pdf"
|
|
dest `shouldBe` src
|
|
|
|
testXFTPContinueRcv :: HasCallStack => TestParams -> IO ()
|
|
testXFTPContinueRcv ps = do
|
|
withXFTPServer $ do
|
|
withNewTestChat ps "alice" aliceProfile $ \alice -> do
|
|
withNewTestChat ps "bob" bobProfile $ \bob -> do
|
|
connectUsers alice bob
|
|
|
|
alice #> "/f @bob ./tests/fixtures/test.pdf"
|
|
alice <## "use /fc 1 to cancel sending"
|
|
bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)"
|
|
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
|
alice <## "completed uploading file 1 (test.pdf) for bob"
|
|
|
|
-- server is down - file is not received
|
|
withTestChat ps "bob" $ \bob -> do
|
|
bob <## "1 contacts connected (use /cs for the list)"
|
|
bob ##> "/fr 1 ./tests/tmp"
|
|
bob
|
|
<### [ "saving file 1 from alice to ./tests/tmp/test.pdf",
|
|
"started receiving file 1 (test.pdf) from alice"
|
|
]
|
|
|
|
bob ##> "/fs 1"
|
|
bob <## "receiving file 1 (test.pdf) progress 0% of 266.0 KiB"
|
|
|
|
(bob </)
|
|
|
|
withXFTPServer $ do
|
|
-- server is up - file reception is continued
|
|
withTestChat ps "bob" $ \bob -> do
|
|
bob <## "1 contacts connected (use /cs for the list)"
|
|
bob <## "completed receiving file 1 (test.pdf) from alice"
|
|
src <- B.readFile "./tests/fixtures/test.pdf"
|
|
dest <- B.readFile "./tests/tmp/test.pdf"
|
|
dest `shouldBe` src
|
|
|
|
testXFTPMarkToReceive :: HasCallStack => TestParams -> IO ()
|
|
testXFTPMarkToReceive = do
|
|
testChat2 aliceProfile bobProfile $ \alice bob -> do
|
|
withXFTPServer $ do
|
|
connectUsers alice bob
|
|
|
|
alice #> "/f @bob ./tests/fixtures/test.pdf"
|
|
alice <## "use /fc 1 to cancel sending"
|
|
bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)"
|
|
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
|
alice <## "completed uploading file 1 (test.pdf) for bob"
|
|
bob #$> ("/_set_file_to_receive 1", id, "ok")
|
|
|
|
threadDelay 100000
|
|
|
|
bob ##> "/_stop"
|
|
bob <## "chat stopped"
|
|
|
|
bob #$> ("/_files_folder ./tests/tmp/bob_files", id, "ok")
|
|
bob #$> ("/_temp_folder ./tests/tmp/bob_xftp", id, "ok")
|
|
|
|
threadDelay 100000
|
|
|
|
bob ##> "/_start"
|
|
bob <## "chat started"
|
|
|
|
bob
|
|
<### [ "1 contacts connected (use /cs for the list)",
|
|
"started receiving file 1 (test.pdf) from alice",
|
|
"saving file 1 from alice to test.pdf"
|
|
]
|
|
bob <## "completed receiving file 1 (test.pdf) from alice"
|
|
|
|
src <- B.readFile "./tests/fixtures/test.pdf"
|
|
dest <- B.readFile "./tests/tmp/bob_files/test.pdf"
|
|
dest `shouldBe` src
|
|
|
|
testXFTPRcvError :: HasCallStack => TestParams -> IO ()
|
|
testXFTPRcvError ps = do
|
|
withXFTPServer $ do
|
|
withNewTestChat ps "alice" aliceProfile $ \alice -> do
|
|
withNewTestChat ps "bob" bobProfile $ \bob -> do
|
|
connectUsers alice bob
|
|
|
|
alice #> "/f @bob ./tests/fixtures/test.pdf"
|
|
alice <## "use /fc 1 to cancel sending"
|
|
bob <# "alice> sends file test.pdf (266.0 KiB / 272376 bytes)"
|
|
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
|
alice <## "completed uploading file 1 (test.pdf) for bob"
|
|
|
|
-- server is up w/t store log - file reception should fail
|
|
withXFTPServer' xftpServerConfig {storeLogFile = Nothing} $ do
|
|
withTestChat ps "bob" $ \bob -> do
|
|
bob <## "1 contacts connected (use /cs for the list)"
|
|
bob ##> "/fr 1 ./tests/tmp"
|
|
bob
|
|
<### [ "saving file 1 from alice to ./tests/tmp/test.pdf",
|
|
"started receiving file 1 (test.pdf) from alice"
|
|
]
|
|
bob <## "error receiving file 1 (test.pdf) from alice"
|
|
_ <- getTermLine bob
|
|
|
|
bob ##> "/fs 1"
|
|
bob <## "receiving file 1 (test.pdf) error: FileErrAuth"
|
|
|
|
testXFTPCancelRcvRepeat :: HasCallStack => TestParams -> IO ()
|
|
testXFTPCancelRcvRepeat =
|
|
testChatCfg2 cfg aliceProfile bobProfile $ \alice bob -> do
|
|
withXFTPServer $ do
|
|
xftpCLI ["rand", "./tests/tmp/testfile", "17mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile"]
|
|
|
|
connectUsers alice bob
|
|
|
|
alice #> "/f @bob ./tests/tmp/testfile"
|
|
alice <## "use /fc 1 to cancel sending"
|
|
bob <# "alice> sends file testfile (17.0 MiB / 17825792 bytes)"
|
|
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
|
bob ##> "/fr 1 ./tests/tmp"
|
|
concurrentlyN_
|
|
[ alice <## "completed uploading file 1 (testfile) for bob",
|
|
bob
|
|
<### [ "saving file 1 from alice to ./tests/tmp/testfile_1",
|
|
"started receiving file 1 (testfile) from alice"
|
|
]
|
|
]
|
|
|
|
threadDelay 100000
|
|
|
|
bob ##> "/fs 1"
|
|
bob <##. "receiving file 1 (testfile) progress"
|
|
|
|
bob ##> "/fc 1"
|
|
bob <## "cancelled receiving file 1 (testfile) from alice"
|
|
|
|
bob ##> "/fs 1"
|
|
bob <## "receiving file 1 (testfile) not accepted yet, use /fr 1 to receive file"
|
|
|
|
bob ##> "/fr 1 ./tests/tmp"
|
|
bob
|
|
<### [ "saving file 1 from alice to ./tests/tmp/testfile_1",
|
|
"started receiving file 1 (testfile) from alice",
|
|
StartsWith "chat db error: SERcvFileNotFoundXFTP"
|
|
]
|
|
bob <## "completed receiving file 1 (testfile) from alice"
|
|
|
|
bob ##> "/fs 1"
|
|
bob <## "receiving file 1 (testfile) complete, path: ./tests/tmp/testfile_1"
|
|
|
|
src <- B.readFile "./tests/tmp/testfile"
|
|
dest <- B.readFile "./tests/tmp/testfile_1"
|
|
dest `shouldBe` src
|
|
where
|
|
cfg = testCfg {xftpDescrPartSize = 200}
|
|
|
|
testAutoAcceptFile :: HasCallStack => TestParams -> IO ()
|
|
testAutoAcceptFile =
|
|
testChatOpts2 opts aliceProfile bobProfile $ \alice bob -> withXFTPServer $ do
|
|
connectUsers alice bob
|
|
bob ##> "/_files_folder ./tests/tmp/bob_files"
|
|
bob <## "ok"
|
|
alice #> "/f @bob ./tests/fixtures/test.jpg"
|
|
alice <## "use /fc 1 to cancel sending"
|
|
alice <## "completed uploading file 1 (test.jpg) for bob"
|
|
bob <# "alice> sends file test.jpg (136.5 KiB / 139737 bytes)"
|
|
bob <## "use /fr 1 [<dir>/ | <path>] to receive it"
|
|
bob <## "saving file 1 from alice to test.jpg"
|
|
bob <## "started receiving file 1 (test.jpg) from alice"
|
|
bob <## "completed receiving file 1 (test.jpg) from alice"
|
|
(bob </)
|
|
alice #> "/f @bob ./tests/fixtures/test_1MB.pdf"
|
|
alice <## "use /fc 2 to cancel sending"
|
|
alice <## "completed uploading file 2 (test_1MB.pdf) for bob"
|
|
bob <# "alice> sends file test_1MB.pdf (1017.7 KiB / 1042157 bytes)"
|
|
bob <## "use /fr 2 [<dir>/ | <path>] to receive it"
|
|
-- no auto accept for large files
|
|
(bob </)
|
|
where
|
|
opts = (testOpts :: ChatOpts) {autoAcceptFileSize = 200000}
|
|
|
|
testProhibitFiles :: HasCallStack => TestParams -> IO ()
|
|
testProhibitFiles =
|
|
testChat3 aliceProfile bobProfile cathProfile $ \alice bob cath -> withXFTPServer $ do
|
|
createGroup3 "team" alice bob cath
|
|
alice ##> "/set files #team off"
|
|
alice <## "updated group preferences:"
|
|
alice <## "Files and media: off"
|
|
concurrentlyN_
|
|
[ do
|
|
bob <## "alice updated group #team:"
|
|
bob <## "updated group preferences:"
|
|
bob <## "Files and media: off",
|
|
do
|
|
cath <## "alice updated group #team:"
|
|
cath <## "updated group preferences:"
|
|
cath <## "Files and media: off"
|
|
]
|
|
alice ##> "/f #team ./tests/fixtures/test.jpg"
|
|
alice <## "bad chat command: feature not allowed Files and media"
|
|
(bob </)
|
|
(cath </)
|
|
|
|
testXFTPStandaloneSmall :: HasCallStack => TestParams -> IO ()
|
|
testXFTPStandaloneSmall = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do
|
|
withXFTPServer $ do
|
|
logNote "sending"
|
|
src ##> "/_upload 1 ./tests/fixtures/logo.jpg"
|
|
src <## "started standalone uploading file 1 (logo.jpg)"
|
|
-- silent progress events
|
|
threadDelay 250000
|
|
src <## "file 1 (logo.jpg) upload complete. download with:"
|
|
-- file description fits, enjoy the direct URIs
|
|
_uri1 <- getTermLine src
|
|
_uri2 <- getTermLine src
|
|
uri3 <- getTermLine src
|
|
_uri4 <- getTermLine src
|
|
|
|
logNote "receiving"
|
|
let dstFile = "./tests/tmp/logo.jpg"
|
|
dst ##> ("/_download 1 " <> uri3 <> " " <> dstFile)
|
|
dst <## "started standalone receiving file 1 (logo.jpg)"
|
|
-- silent progress events
|
|
threadDelay 250000
|
|
dst <## "completed standalone receiving file 1 (logo.jpg)"
|
|
srcBody <- B.readFile "./tests/fixtures/logo.jpg"
|
|
B.readFile dstFile `shouldReturn` srcBody
|
|
|
|
testXFTPStandaloneSmallInfo :: HasCallStack => TestParams -> IO ()
|
|
testXFTPStandaloneSmallInfo = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do
|
|
withXFTPServer $ do
|
|
logNote "sending"
|
|
src ##> "/_upload 1 ./tests/fixtures/logo.jpg"
|
|
src <## "started standalone uploading file 1 (logo.jpg)"
|
|
-- silent progress events
|
|
threadDelay 250000
|
|
src <## "file 1 (logo.jpg) upload complete. download with:"
|
|
-- file description fits, enjoy the direct URIs
|
|
_uri1 <- getTermLine src
|
|
_uri2 <- getTermLine src
|
|
uri3 <- getTermLine src
|
|
_uri4 <- getTermLine src
|
|
let uri = uri3 <> "&data=" <> B.unpack (urlEncode False . LB.toStrict . J.encode $ J.object ["secret" J..= J.String "*********"])
|
|
|
|
logNote "info"
|
|
dst ##> ("/_download info " <> uri)
|
|
dst <## "{\"secret\":\"*********\"}"
|
|
|
|
logNote "receiving"
|
|
let dstFile = "./tests/tmp/logo.jpg"
|
|
dst ##> ("/_download 1 " <> uri <> " " <> dstFile) -- download sucessfully discarded extra info
|
|
dst <## "started standalone receiving file 1 (logo.jpg)"
|
|
-- silent progress events
|
|
threadDelay 250000
|
|
dst <## "completed standalone receiving file 1 (logo.jpg)"
|
|
srcBody <- B.readFile "./tests/fixtures/logo.jpg"
|
|
B.readFile dstFile `shouldReturn` srcBody
|
|
|
|
testXFTPStandaloneLarge :: HasCallStack => TestParams -> IO ()
|
|
testXFTPStandaloneLarge = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do
|
|
withXFTPServer $ do
|
|
xftpCLI ["rand", "./tests/tmp/testfile.in", "17mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile.in"]
|
|
|
|
logNote "sending"
|
|
src ##> "/_upload 1 ./tests/tmp/testfile.in"
|
|
src <## "started standalone uploading file 1 (testfile.in)"
|
|
-- silent progress events
|
|
threadDelay 250000
|
|
src <## "file 1 (testfile.in) uploaded, preparing redirect file 2"
|
|
src <## "file 1 (testfile.in) upload complete. download with:"
|
|
uri <- getTermLine src
|
|
_uri2 <- getTermLine src
|
|
_uri3 <- getTermLine src
|
|
_uri4 <- getTermLine src
|
|
|
|
logNote "receiving"
|
|
let dstFile = "./tests/tmp/testfile.out"
|
|
dst ##> ("/_download 1 " <> uri <> " " <> dstFile)
|
|
dst <## "started standalone receiving file 1 (testfile.out)"
|
|
-- silent progress events
|
|
threadDelay 250000
|
|
dst <## "completed standalone receiving file 1 (testfile.out)"
|
|
srcBody <- B.readFile "./tests/tmp/testfile.in"
|
|
B.readFile dstFile `shouldReturn` srcBody
|
|
|
|
testXFTPStandaloneLargeInfo :: HasCallStack => TestParams -> IO ()
|
|
testXFTPStandaloneLargeInfo = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do
|
|
withXFTPServer $ do
|
|
xftpCLI ["rand", "./tests/tmp/testfile.in", "17mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile.in"]
|
|
|
|
logNote "sending"
|
|
src ##> "/_upload 1 ./tests/tmp/testfile.in"
|
|
src <## "started standalone uploading file 1 (testfile.in)"
|
|
|
|
-- silent progress events
|
|
threadDelay 250000
|
|
src <## "file 1 (testfile.in) uploaded, preparing redirect file 2"
|
|
src <## "file 1 (testfile.in) upload complete. download with:"
|
|
uri1 <- getTermLine src
|
|
_uri2 <- getTermLine src
|
|
_uri3 <- getTermLine src
|
|
_uri4 <- getTermLine src
|
|
let uri = uri1 <> "&data=" <> B.unpack (urlEncode False . LB.toStrict . J.encode $ J.object ["secret" J..= J.String "*********"])
|
|
|
|
logNote "info"
|
|
dst ##> ("/_download info " <> uri)
|
|
dst <## "{\"secret\":\"*********\"}"
|
|
|
|
logNote "receiving"
|
|
let dstFile = "./tests/tmp/testfile.out"
|
|
dst ##> ("/_download 1 " <> uri <> " " <> dstFile)
|
|
dst <## "started standalone receiving file 1 (testfile.out)"
|
|
-- silent progress events
|
|
threadDelay 250000
|
|
dst <## "completed standalone receiving file 1 (testfile.out)"
|
|
srcBody <- B.readFile "./tests/tmp/testfile.in"
|
|
B.readFile dstFile `shouldReturn` srcBody
|
|
|
|
testXFTPStandaloneCancelSnd :: HasCallStack => TestParams -> IO ()
|
|
testXFTPStandaloneCancelSnd = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do
|
|
withXFTPServer $ do
|
|
xftpCLI ["rand", "./tests/tmp/testfile.in", "17mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile.in"]
|
|
|
|
logNote "sending"
|
|
src ##> "/_upload 1 ./tests/tmp/testfile.in"
|
|
src <## "started standalone uploading file 1 (testfile.in)"
|
|
-- silent progress events
|
|
threadDelay 250000
|
|
src <## "file 1 (testfile.in) uploaded, preparing redirect file 2"
|
|
src <## "file 1 (testfile.in) upload complete. download with:"
|
|
uri <- getTermLine src
|
|
_uri2 <- getTermLine src
|
|
_uri3 <- getTermLine src
|
|
_uri4 <- getTermLine src
|
|
|
|
logNote "cancelling"
|
|
src ##> "/fc 1"
|
|
src <## "cancelled sending file 1 (testfile.in)"
|
|
threadDelay 1000000
|
|
|
|
logNote "trying to receive cancelled"
|
|
dst ##> ("/_download 1 " <> uri <> " " <> "./tests/tmp/should.not.extist")
|
|
dst <## "started standalone receiving file 1 (should.not.extist)"
|
|
threadDelay 100000
|
|
logWarn "no error?"
|
|
dst <## "error receiving file 1 (should.not.extist)"
|
|
dst <## "INTERNAL {internalErr = \"XFTP {xftpErr = AUTH}\"}"
|
|
|
|
testXFTPStandaloneRelativePaths :: HasCallStack => TestParams -> IO ()
|
|
testXFTPStandaloneRelativePaths = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do
|
|
withXFTPServer $ do
|
|
logNote "sending"
|
|
src #$> ("/_files_folder ./tests/tmp/src_files", id, "ok")
|
|
src #$> ("/_temp_folder ./tests/tmp/src_xftp_temp", id, "ok")
|
|
|
|
xftpCLI ["rand", "./tests/tmp/src_files/testfile.in", "17mb"] `shouldReturn` ["File created: " <> "./tests/tmp/src_files/testfile.in"]
|
|
|
|
src ##> "/_upload 1 testfile.in"
|
|
src <## "started standalone uploading file 1 (testfile.in)"
|
|
-- silent progress events
|
|
threadDelay 250000
|
|
src <## "file 1 (testfile.in) uploaded, preparing redirect file 2"
|
|
src <## "file 1 (testfile.in) upload complete. download with:"
|
|
uri <- getTermLine src
|
|
_uri2 <- getTermLine src
|
|
_uri3 <- getTermLine src
|
|
_uri4 <- getTermLine src
|
|
|
|
logNote "receiving"
|
|
dst #$> ("/_files_folder ./tests/tmp/dst_files", id, "ok")
|
|
dst #$> ("/_temp_folder ./tests/tmp/dst_xftp_temp", id, "ok")
|
|
dst ##> ("/_download 1 " <> uri <> " testfile.out")
|
|
dst <## "started standalone receiving file 1 (testfile.out)"
|
|
-- silent progress events
|
|
threadDelay 250000
|
|
dst <## "completed standalone receiving file 1 (testfile.out)"
|
|
srcBody <- B.readFile "./tests/tmp/src_files/testfile.in"
|
|
B.readFile "./tests/tmp/dst_files/testfile.out" `shouldReturn` srcBody
|
|
|
|
testXFTPStandaloneCancelRcv :: HasCallStack => TestParams -> IO ()
|
|
testXFTPStandaloneCancelRcv = testChat2 aliceProfile aliceDesktopProfile $ \src dst -> do
|
|
withXFTPServer $ do
|
|
xftpCLI ["rand", "./tests/tmp/testfile.in", "17mb"] `shouldReturn` ["File created: " <> "./tests/tmp/testfile.in"]
|
|
|
|
logNote "sending"
|
|
src ##> "/_upload 1 ./tests/tmp/testfile.in"
|
|
src <## "started standalone uploading file 1 (testfile.in)"
|
|
-- silent progress events
|
|
threadDelay 250000
|
|
src <## "file 1 (testfile.in) uploaded, preparing redirect file 2"
|
|
src <## "file 1 (testfile.in) upload complete. download with:"
|
|
uri <- getTermLine src
|
|
_uri2 <- getTermLine src
|
|
_uri3 <- getTermLine src
|
|
_uri4 <- getTermLine src
|
|
|
|
logNote "receiving"
|
|
let dstFile = "./tests/tmp/testfile.out"
|
|
dst ##> ("/_download 1 " <> uri <> " " <> dstFile)
|
|
dst <## "started standalone receiving file 1 (testfile.out)"
|
|
threadDelay 25000 -- give workers some time to avoid internal errors from starting tasks
|
|
logNote "cancelling"
|
|
dst ##> "/fc 1"
|
|
dst <## "cancelled receiving file 1 (testfile.out)"
|
|
threadDelay 25000
|
|
doesFileExist dstFile `shouldReturn` False
|