mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-04-25 16:22:16 +00:00
e63e0be2ac
- xftpTest/xftpTest2/xftpTest4/xftpTestN now take XFTPTestBracket as first argument, enabling the same test to run against both memory and PostgreSQL backends. - xftpFileTests (server tests), xftpAgentFileTests (agent tests), and xftpCLIFileTests (CLI tests) are SpecWith-parameterized suites that receive the bracket from HSpec's before combinator. - Test.hs runs each parameterized suite twice: once with xftpMemoryBracket, once with xftpPostgresBracket (CPP-guarded). - STM-specific tests (store log restore/replay) stay in memory-only xftpAgentTests. SNI/CORS tests stay in memory-only xftpServerTests.
275 lines
12 KiB
Haskell
275 lines
12 KiB
Haskell
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module CoreTests.XFTPStoreTests (xftpStoreTests, xftpMigrationTests) where
|
|
|
|
import Control.Monad
|
|
import Data.Word (Word32)
|
|
import Simplex.FileTransfer.Protocol (FileInfo (..), SFileParty (..))
|
|
import Simplex.FileTransfer.Server.Store
|
|
import Simplex.FileTransfer.Server.Store.Postgres (PostgresFileStore, importFileStore, exportFileStore)
|
|
import Simplex.FileTransfer.Server.StoreLog (closeStoreLog, readWriteFileStore, writeFileStore)
|
|
import Simplex.FileTransfer.Transport (XFTPErrorType (..))
|
|
import qualified Simplex.Messaging.Crypto as C
|
|
import Simplex.Messaging.Protocol (BlockingInfo (..), BlockingReason (..), EntityId (..))
|
|
import Simplex.Messaging.Server.QueueStore (ServerEntityStatus (..))
|
|
import Simplex.Messaging.Server.StoreLog (openWriteStoreLog)
|
|
import Simplex.Messaging.SystemTime (RoundedSystemTime (..))
|
|
import System.Directory (doesFileExist, removeFile)
|
|
import Test.Hspec hiding (fit, it)
|
|
import UnliftIO.STM
|
|
import Util
|
|
import XFTPClient (testXFTPPostgresCfg)
|
|
|
|
xftpStoreTests :: Spec
|
|
xftpStoreTests = describe "PostgresFileStore operations" $ do
|
|
it "should add and get file by sender" testAddGetFileSender
|
|
it "should add and get file by recipient" testAddGetFileRecipient
|
|
it "should reject duplicate file" testDuplicateFile
|
|
it "should return AUTH for nonexistent file" testGetNonexistent
|
|
it "should set file path with IS NULL guard" testSetFilePath
|
|
it "should reject duplicate recipient" testDuplicateRecipient
|
|
it "should delete file and cascade recipients" testDeleteFileCascade
|
|
it "should block file and update status" testBlockFile
|
|
it "should ack file reception" testAckFile
|
|
it "should return expired files with limit" testExpiredFiles
|
|
it "should compute used storage and file count" testStorageAndCount
|
|
|
|
xftpMigrationTests :: Spec
|
|
xftpMigrationTests = describe "XFTP migration round-trip" $ do
|
|
it "should export to StoreLog and import back to Postgres preserving data" testMigrationRoundTrip
|
|
|
|
-- Test helpers
|
|
|
|
withPgStore :: (PostgresFileStore -> IO ()) -> IO ()
|
|
withPgStore test = do
|
|
st <- newFileStore testXFTPPostgresCfg :: IO PostgresFileStore
|
|
test st
|
|
closeFileStore st
|
|
|
|
testSenderId :: EntityId
|
|
testSenderId = EntityId "sender001_______"
|
|
|
|
testRecipientId :: EntityId
|
|
testRecipientId = EntityId "recipient001____"
|
|
|
|
testFileInfo :: C.APublicAuthKey -> FileInfo
|
|
testFileInfo sndKey =
|
|
FileInfo
|
|
{ sndKey,
|
|
size = 128000 :: Word32,
|
|
digest = "test_digest_bytes_here___"
|
|
}
|
|
|
|
testCreatedAt :: RoundedFileTime
|
|
testCreatedAt = RoundedSystemTime 1000000
|
|
|
|
-- Tests
|
|
|
|
testAddGetFileSender :: Expectation
|
|
testAddGetFileSender = withPgStore $ \st -> do
|
|
g <- C.newRandom
|
|
(sk, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
|
|
let fileInfo = testFileInfo sk
|
|
addFile st testSenderId fileInfo testCreatedAt EntityActive `shouldReturn` Right ()
|
|
result <- getFile st SFSender testSenderId
|
|
case result of
|
|
Right (FileRec {senderId, fileInfo = fi, createdAt}, key) -> do
|
|
senderId `shouldBe` testSenderId
|
|
sndKey fi `shouldBe` sk
|
|
size fi `shouldBe` 128000
|
|
createdAt `shouldBe` testCreatedAt
|
|
key `shouldBe` sk
|
|
Left e -> expectationFailure $ "getFile failed: " <> show e
|
|
|
|
testAddGetFileRecipient :: Expectation
|
|
testAddGetFileRecipient = withPgStore $ \st -> do
|
|
g <- C.newRandom
|
|
(sndKey, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
|
|
(rcpKey, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
|
|
let fileInfo = testFileInfo sndKey
|
|
addFile st testSenderId fileInfo testCreatedAt EntityActive `shouldReturn` Right ()
|
|
addRecipient st testSenderId (FileRecipient testRecipientId rcpKey) `shouldReturn` Right ()
|
|
result <- getFile st SFRecipient testRecipientId
|
|
case result of
|
|
Right (FileRec {senderId}, key) -> do
|
|
senderId `shouldBe` testSenderId
|
|
key `shouldBe` rcpKey
|
|
Left e -> expectationFailure $ "getFile failed: " <> show e
|
|
|
|
testDuplicateFile :: Expectation
|
|
testDuplicateFile = withPgStore $ \st -> do
|
|
g <- C.newRandom
|
|
(sndKey, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
|
|
let fileInfo = testFileInfo sndKey
|
|
addFile st testSenderId fileInfo testCreatedAt EntityActive `shouldReturn` Right ()
|
|
addFile st testSenderId fileInfo testCreatedAt EntityActive `shouldReturn` Left DUPLICATE_
|
|
|
|
testGetNonexistent :: Expectation
|
|
testGetNonexistent = withPgStore $ \st -> do
|
|
getFile st SFSender testSenderId >>= (`shouldBe` Left AUTH) . fmap (const ())
|
|
getFile st SFRecipient testRecipientId >>= (`shouldBe` Left AUTH) . fmap (const ())
|
|
|
|
testSetFilePath :: Expectation
|
|
testSetFilePath = withPgStore $ \st -> do
|
|
g <- C.newRandom
|
|
(sndKey, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
|
|
let fileInfo = testFileInfo sndKey
|
|
addFile st testSenderId fileInfo testCreatedAt EntityActive `shouldReturn` Right ()
|
|
setFilePath st testSenderId "/tmp/test_file" `shouldReturn` Right ()
|
|
-- Second setFilePath should fail (file_path IS NULL guard)
|
|
setFilePath st testSenderId "/tmp/other_file" `shouldReturn` Left AUTH
|
|
-- Verify path was set
|
|
result <- getFile st SFSender testSenderId
|
|
case result of
|
|
Right (FileRec {filePath}, _) -> readTVarIO filePath `shouldReturn` Just "/tmp/test_file"
|
|
Left e -> expectationFailure $ "getFile failed: " <> show e
|
|
|
|
testDuplicateRecipient :: Expectation
|
|
testDuplicateRecipient = withPgStore $ \st -> do
|
|
g <- C.newRandom
|
|
(sndKey, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
|
|
(rcpKey, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
|
|
let fileInfo = testFileInfo sndKey
|
|
addFile st testSenderId fileInfo testCreatedAt EntityActive `shouldReturn` Right ()
|
|
addRecipient st testSenderId (FileRecipient testRecipientId rcpKey) `shouldReturn` Right ()
|
|
addRecipient st testSenderId (FileRecipient testRecipientId rcpKey) `shouldReturn` Left DUPLICATE_
|
|
|
|
testDeleteFileCascade :: Expectation
|
|
testDeleteFileCascade = withPgStore $ \st -> do
|
|
g <- C.newRandom
|
|
(sndKey, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
|
|
(rcpKey, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
|
|
let fileInfo = testFileInfo sndKey
|
|
addFile st testSenderId fileInfo testCreatedAt EntityActive `shouldReturn` Right ()
|
|
addRecipient st testSenderId (FileRecipient testRecipientId rcpKey) `shouldReturn` Right ()
|
|
deleteFile st testSenderId `shouldReturn` Right ()
|
|
-- File and recipient should both be gone
|
|
getFile st SFSender testSenderId >>= (`shouldBe` Left AUTH) . fmap (const ())
|
|
getFile st SFRecipient testRecipientId >>= (`shouldBe` Left AUTH) . fmap (const ())
|
|
|
|
testBlockFile :: Expectation
|
|
testBlockFile = withPgStore $ \st -> do
|
|
g <- C.newRandom
|
|
(sndKey, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
|
|
let fileInfo = testFileInfo sndKey
|
|
addFile st testSenderId fileInfo testCreatedAt EntityActive `shouldReturn` Right ()
|
|
let blockInfo = BlockingInfo {reason = BRContent, notice = Nothing}
|
|
blockFile st testSenderId blockInfo False `shouldReturn` Right ()
|
|
result <- getFile st SFSender testSenderId
|
|
case result of
|
|
Right (FileRec {fileStatus}, _) -> readTVarIO fileStatus `shouldReturn` EntityBlocked blockInfo
|
|
Left e -> expectationFailure $ "getFile failed: " <> show e
|
|
|
|
testAckFile :: Expectation
|
|
testAckFile = withPgStore $ \st -> do
|
|
g <- C.newRandom
|
|
(sndKey, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
|
|
(rcpKey, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
|
|
let fileInfo = testFileInfo sndKey
|
|
addFile st testSenderId fileInfo testCreatedAt EntityActive `shouldReturn` Right ()
|
|
addRecipient st testSenderId (FileRecipient testRecipientId rcpKey) `shouldReturn` Right ()
|
|
ackFile st testRecipientId `shouldReturn` Right ()
|
|
-- Recipient gone, but file still exists
|
|
getFile st SFRecipient testRecipientId >>= (`shouldBe` Left AUTH) . fmap (const ())
|
|
result <- getFile st SFSender testSenderId
|
|
case result of
|
|
Right _ -> pure ()
|
|
Left e -> expectationFailure $ "getFile failed: " <> show e
|
|
|
|
testExpiredFiles :: Expectation
|
|
testExpiredFiles = withPgStore $ \st -> do
|
|
g <- C.newRandom
|
|
(sndKey, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
|
|
let fileInfo = testFileInfo sndKey
|
|
oldTime = RoundedSystemTime 100000
|
|
newTime = RoundedSystemTime 999999999
|
|
-- Add old and new files
|
|
addFile st (EntityId "old_file________") fileInfo oldTime EntityActive `shouldReturn` Right ()
|
|
void $ setFilePath st (EntityId "old_file________") "/tmp/old"
|
|
addFile st (EntityId "new_file________") fileInfo newTime EntityActive `shouldReturn` Right ()
|
|
-- Query expired with cutoff that only catches old file
|
|
expired <- expiredFiles st 500000 100
|
|
length expired `shouldBe` 1
|
|
case expired of
|
|
[(sId, path, sz)] -> do
|
|
sId `shouldBe` EntityId "old_file________"
|
|
path `shouldBe` Just "/tmp/old"
|
|
sz `shouldBe` 128000
|
|
_ -> expectationFailure "expected 1 expired file"
|
|
|
|
testStorageAndCount :: Expectation
|
|
testStorageAndCount = withPgStore $ \st -> do
|
|
g <- C.newRandom
|
|
(sndKey, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
|
|
getUsedStorage st `shouldReturn` 0
|
|
getFileCount st `shouldReturn` 0
|
|
let fileInfo = testFileInfo sndKey
|
|
addFile st (EntityId "file_a__________") fileInfo testCreatedAt EntityActive `shouldReturn` Right ()
|
|
addFile st (EntityId "file_b__________") fileInfo testCreatedAt EntityActive `shouldReturn` Right ()
|
|
getFileCount st `shouldReturn` 2
|
|
used <- getUsedStorage st
|
|
used `shouldBe` 256000 -- 128000 * 2
|
|
|
|
-- Migration round-trip test
|
|
|
|
testMigrationRoundTrip :: Expectation
|
|
testMigrationRoundTrip = do
|
|
let storeLogPath = "tests/tmp/xftp-migration-test.log"
|
|
storeLogPath2 = "tests/tmp/xftp-migration-test2.log"
|
|
-- 1. Create STM store with test data
|
|
stmStore <- newFileStore () :: IO STMFileStore
|
|
g <- C.newRandom
|
|
(sndKey1, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
|
|
(rcpKey1, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
|
|
(sndKey2, _) <- atomically $ C.generateAuthKeyPair C.SEd25519 g
|
|
let fileInfo1 = testFileInfo sndKey1
|
|
fileInfo2 = FileInfo {sndKey = sndKey2, size = 64000, digest = "other_digest____________"}
|
|
sId1 = EntityId "migration_file_1"
|
|
sId2 = EntityId "migration_file_2"
|
|
rId1 = EntityId "migration_rcp_1_"
|
|
addFile stmStore sId1 fileInfo1 testCreatedAt EntityActive `shouldReturn` Right ()
|
|
void $ setFilePath stmStore sId1 "/tmp/file1"
|
|
addRecipient stmStore sId1 (FileRecipient rId1 rcpKey1) `shouldReturn` Right ()
|
|
let testBlockInfo = BlockingInfo {reason = BRSpam, notice = Nothing}
|
|
addFile stmStore sId2 fileInfo2 testCreatedAt (EntityBlocked testBlockInfo) `shouldReturn` Right ()
|
|
-- 2. Write to StoreLog
|
|
sl <- openWriteStoreLog False storeLogPath
|
|
writeFileStore sl stmStore
|
|
closeStoreLog sl
|
|
-- 3. Import StoreLog to Postgres
|
|
importFileStore storeLogPath testXFTPPostgresCfg
|
|
-- StoreLog should be renamed to .bak
|
|
doesFileExist storeLogPath `shouldReturn` False
|
|
doesFileExist (storeLogPath <> ".bak") `shouldReturn` True
|
|
-- 4. Export from Postgres back to StoreLog
|
|
exportFileStore storeLogPath2 testXFTPPostgresCfg
|
|
-- 5. Read exported StoreLog into a new STM store and verify
|
|
stmStore2 <- newFileStore () :: IO STMFileStore
|
|
sl2 <- readWriteFileStore storeLogPath2 stmStore2
|
|
closeStoreLog sl2
|
|
-- Verify file 1
|
|
result1 <- getFile stmStore2 SFSender sId1
|
|
case result1 of
|
|
Right (FileRec {fileInfo = fi, filePath, fileStatus}, _) -> do
|
|
size fi `shouldBe` 128000
|
|
readTVarIO filePath `shouldReturn` Just "/tmp/file1"
|
|
readTVarIO fileStatus `shouldReturn` EntityActive
|
|
Left e -> expectationFailure $ "getFile sId1 failed: " <> show e
|
|
-- Verify recipient
|
|
result1r <- getFile stmStore2 SFRecipient rId1
|
|
case result1r of
|
|
Right (_, key) -> key `shouldBe` rcpKey1
|
|
Left e -> expectationFailure $ "getFile rId1 failed: " <> show e
|
|
-- Verify file 2 (blocked)
|
|
result2 <- getFile stmStore2 SFSender sId2
|
|
case result2 of
|
|
Right (FileRec {fileInfo = fi, fileStatus}, _) -> do
|
|
size fi `shouldBe` 64000
|
|
readTVarIO fileStatus `shouldReturn` EntityBlocked (BlockingInfo {reason = BRSpam, notice = Nothing})
|
|
Left e -> expectationFailure $ "getFile sId2 failed: " <> show e
|
|
-- Cleanup
|
|
removeFile (storeLogPath <> ".bak")
|
|
removeFile storeLogPath2
|