diff --git a/simplexmq.cabal b/simplexmq.cabal index 21b02ce0b..919dd272a 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -527,6 +527,7 @@ test-suite simplexmq-test if flag(server_postgres) other-modules: AgentTests.NotificationTests + CoreTests.XFTPStoreTests NtfClient NtfServerTests PostgresSchemaDump diff --git a/src/Simplex/FileTransfer/Server/Store/Postgres.hs b/src/Simplex/FileTransfer/Server/Store/Postgres.hs index 08ca4ce98..b35e3cd72 100644 --- a/src/Simplex/FileTransfer/Server/Store/Postgres.hs +++ b/src/Simplex/FileTransfer/Server/Store/Postgres.hs @@ -180,7 +180,7 @@ instance FileStoreClass PostgresFileStore where getUsedStorage st = withTransaction (dbStore st) $ \db -> do - [Only total] <- DB.query_ db "SELECT COALESCE(SUM(file_size::INT8), 0) FROM files" + [Only total] <- DB.query_ db "SELECT COALESCE(SUM(file_size::INT8), 0)::INT8 FROM files" pure total getFileCount st = diff --git a/src/Simplex/FileTransfer/Server/StoreLog.hs b/src/Simplex/FileTransfer/Server/StoreLog.hs index dc65e4a22..a6747257b 100644 --- a/src/Simplex/FileTransfer/Server/StoreLog.hs +++ b/src/Simplex/FileTransfer/Server/StoreLog.hs @@ -10,6 +10,7 @@ module Simplex.FileTransfer.Server.StoreLog FileStoreLogRecord (..), closeStoreLog, readWriteFileStore, + writeFileStore, logAddFile, logPutFile, logAddRecipients, diff --git a/tests/CoreTests/XFTPStoreTests.hs b/tests/CoreTests/XFTPStoreTests.hs new file mode 100644 index 000000000..91e395976 --- /dev/null +++ b/tests/CoreTests/XFTPStoreTests.hs @@ -0,0 +1,284 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module CoreTests.XFTPStoreTests (xftpStoreTests, xftpMigrationTests) where + +import Control.Monad +import qualified Data.ByteString.Char8 as B +import Data.Word (Word32) +import qualified Data.Set as S +import Simplex.FileTransfer.Protocol (FileInfo (..), SFileParty (..)) +import Simplex.FileTransfer.Server.Store +import Simplex.FileTransfer.Server.Store.Postgres (PostgresFileStore) +import Simplex.FileTransfer.Server.Store.Postgres.Config (PostgresFileStoreCfg) +import Simplex.FileTransfer.Server.Store.STM (STMFileStore (..)) +import Simplex.FileTransfer.Server.StoreLog +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.SystemTime (RoundedSystemTime (..)) +import Simplex.FileTransfer.Server.Store.Postgres (importFileStore, exportFileStore) +import Simplex.FileTransfer.Server.StoreLog (readWriteFileStore, writeFileStore) +import Simplex.Messaging.Server.StoreLog (openWriteStoreLog) +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____" + +testRecipientId2 :: EntityId +testRecipientId2 = EntityId "recipient002____" + +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 diff --git a/tests/Test.hs b/tests/Test.hs index 63f97d807..830321561 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -46,12 +46,15 @@ import AgentTests.SchemaDump (schemaDumpTest) #endif #if defined(dbServerPostgres) +import CoreTests.XFTPStoreTests (xftpStoreTests, xftpMigrationTests) import NtfServerTests (ntfServerTests) import NtfClient (ntfTestServerDBConnectInfo, ntfTestStoreDBOpts) import PostgresSchemaDump (postgresSchemaDumpTest) import SMPClient (testServerDBConnectInfo, testStoreDBOpts) import Simplex.Messaging.Notifications.Server.Store.Migrations (ntfServerMigrations) import Simplex.Messaging.Server.QueueStore.Postgres.Migrations (serverMigrations) +import XFTPClient (testXFTPDBConnectInfo) +import XFTPServerTests (xftpServerTestsPg) #endif #if defined(dbPostgres) || defined(dbServerPostgres) @@ -152,6 +155,12 @@ main = do describe "XFTP file description" fileDescriptionTests describe "XFTP CLI" xftpCLITests describe "XFTP agent" xftpAgentTests +#if defined(dbServerPostgres) + around_ (postgressBracket testXFTPDBConnectInfo) $ do + describe "XFTP Postgres store operations" xftpStoreTests + describe "XFTP migration round-trip" xftpMigrationTests + describe "XFTP server (PostgreSQL backend)" xftpServerTestsPg +#endif #if defined(dbPostgres) describe "XFTP Web Client" $ xftpWebTests (dropAllSchemasExceptSystem testDBConnectInfo) #else diff --git a/tests/XFTPClient.hs b/tests/XFTPClient.hs index 6fcc32669..a9707af63 100644 --- a/tests/XFTPClient.hs +++ b/tests/XFTPClient.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} @@ -15,11 +16,18 @@ import Simplex.FileTransfer.Client import Simplex.FileTransfer.Description import Simplex.FileTransfer.Server (runXFTPServerBlocking) import Simplex.FileTransfer.Server.Env (XFTPServerConfig (..), XFTPStoreConfig (..), defaultFileExpiration, defaultInactiveClientExpiration) +import Simplex.FileTransfer.Server.Store (FileStoreClass) import Simplex.FileTransfer.Transport (alpnSupportedXFTPhandshakes, supportedFileServerVRange) import Simplex.Messaging.Protocol (XFTPServer) import Simplex.Messaging.Transport.HTTP2 (httpALPN) import Simplex.Messaging.Transport.Server import Test.Hspec hiding (fit, it) +#if defined(dbServerPostgres) +import Database.PostgreSQL.Simple (ConnectInfo (..), defaultConnectInfo) +import Simplex.FileTransfer.Server.Store.Postgres.Config (PostgresFileStoreCfg (..), defaultXFTPDBOpts) +import Simplex.Messaging.Agent.Store.Postgres.Options (DBOpts (..)) +import Simplex.Messaging.Agent.Store.Shared (MigrationConfirmation (..)) +#endif xftpTest :: HasCallStack => (HasCallStack => XFTPClient -> IO ()) -> Expectation xftpTest test = runXFTPTest test `shouldReturn` () @@ -192,3 +200,62 @@ testXFTPServerConfigEd25519SNI = { addCORSHeaders = True } } + +-- Store-parameterized server bracket + +withXFTPServerCfgStore :: (HasCallStack, FileStoreClass s) => XFTPStoreConfig s -> XFTPServerConfig -> (HasCallStack => ThreadId -> IO a) -> IO a +withXFTPServerCfgStore storeCfg cfg = + serverBracket + (\started -> runXFTPServerBlocking started storeCfg cfg) + (threadDelay 10000) + +withXFTPServerStore :: (HasCallStack, FileStoreClass s) => XFTPStoreConfig s -> IO a -> IO a +withXFTPServerStore storeCfg = withXFTPServerCfgStore storeCfg testXFTPServerConfig . const + +#if defined(dbServerPostgres) +testXFTPDBConnectInfo :: ConnectInfo +testXFTPDBConnectInfo = + defaultConnectInfo + { connectUser = "test_xftp_server_user", + connectDatabase = "test_xftp_server_db" + } + +testXFTPStoreDBOpts :: DBOpts +testXFTPStoreDBOpts = + defaultXFTPDBOpts + { connstr = "postgresql://test_xftp_server_user@/test_xftp_server_db", + schema = "xftp_server_test", + poolSize = 10, + createSchema = True + } + +testXFTPPostgresCfg :: PostgresFileStoreCfg +testXFTPPostgresCfg = + PostgresFileStoreCfg + { dbOpts = testXFTPStoreDBOpts, + dbStoreLogPath = Nothing, + confirmMigrations = MCYesUp + } + +withXFTPServerPg :: HasCallStack => IO a -> IO a +withXFTPServerPg = withXFTPServerStore (XSCDatabase testXFTPPostgresCfg) + +xftpTestPg :: HasCallStack => (HasCallStack => XFTPClient -> IO ()) -> Expectation +xftpTestPg test = runXFTPTestPg test `shouldReturn` () + +runXFTPTestPg :: HasCallStack => (HasCallStack => XFTPClient -> IO a) -> IO a +runXFTPTestPg test = withXFTPServerPg $ testXFTPClient test + +xftpTestPg2 :: HasCallStack => (HasCallStack => XFTPClient -> XFTPClient -> IO ()) -> Expectation +xftpTestPg2 test = xftpTestPgN 2 _test + where + _test [h1, h2] = test h1 h2 + _test _ = error "expected 2 handles" + +xftpTestPgN :: forall a. HasCallStack => Int -> (HasCallStack => [XFTPClient] -> IO a) -> IO a +xftpTestPgN nClients test = withXFTPServerPg $ run nClients [] + where + run :: Int -> [XFTPClient] -> IO a + run 0 hs = test hs + run n hs = testXFTPClient $ \h -> run (n - 1) (h : hs) +#endif diff --git a/tests/XFTPServerTests.hs b/tests/XFTPServerTests.hs index 0af3d7eca..3d58b3bc2 100644 --- a/tests/XFTPServerTests.hs +++ b/tests/XFTPServerTests.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-} @@ -6,7 +7,11 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} -module XFTPServerTests where +module XFTPServerTests (xftpServerTests +#if defined(dbServerPostgres) + , xftpServerTestsPg +#endif + ) where import AgentTests.FunctionalAPITests (runRight_) import Control.Concurrent (threadDelay) @@ -51,6 +56,10 @@ import Test.Hspec hiding (fit, it) import UnliftIO.STM import Util import XFTPClient +#if defined(dbServerPostgres) +import Simplex.FileTransfer.Server.Env (XFTPStoreConfig (..)) +import XFTPClient (testXFTPPostgresCfg, withXFTPServerCfgStore, xftpTestPg, xftpTestPg2, xftpTestPgN) +#endif xftpServerTests :: Spec xftpServerTests = @@ -598,3 +607,110 @@ testStaleWebSession = decoded <- either (error . show) pure $ C.unPad respBody decoded `shouldBe` smpEncode SESSION +#if defined(dbServerPostgres) +xftpServerTestsPg :: Spec +xftpServerTestsPg = + before_ (createDirectoryIfMissing False xftpServerFiles) . after_ (removeDirectoryRecursive xftpServerFiles) $ do + describe "XFTP file chunk delivery (PostgreSQL)" $ do + it "should create, upload and receive file chunk (1 client)" testFileChunkDeliveryPg + it "should create, upload and receive file chunk (2 clients)" testFileChunkDelivery2Pg + it "should create, add recipients, upload and receive file chunk" testFileChunkDeliveryAddRecipientsPg + it "should delete file chunk (1 client)" testFileChunkDeletePg + it "should delete file chunk (2 clients)" testFileChunkDelete2Pg + it "should acknowledge file chunk reception (1 client)" testFileChunkAckPg + it "should acknowledge file chunk reception (2 clients)" testFileChunkAck2Pg + it "should not allow uploading chunks after specified storage quota" testFileStorageQuotaPg + it "should expire chunks after set interval" testFileChunkExpirationPg + +testFileChunkDeliveryPg :: Expectation +testFileChunkDeliveryPg = xftpTestPg $ \c -> runRight_ $ runTestFileChunkDelivery c c + +testFileChunkDelivery2Pg :: Expectation +testFileChunkDelivery2Pg = xftpTestPg2 $ \s r -> runRight_ $ runTestFileChunkDelivery s r + +testFileChunkDeliveryAddRecipientsPg :: Expectation +testFileChunkDeliveryAddRecipientsPg = xftpTestPgN 4 $ \hs -> case hs of + [s, r1, r2, r3] -> runRight_ $ do + g <- liftIO C.newRandom + (sndKey, spKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g + (rcvKey1, rpKey1) <- atomically $ C.generateAuthKeyPair C.SEd25519 g + (rcvKey2, rpKey2) <- atomically $ C.generateAuthKeyPair C.SEd25519 g + (rcvKey3, rpKey3) <- atomically $ C.generateAuthKeyPair C.SEd25519 g + bytes <- liftIO $ createTestChunk testChunkPath + digest <- liftIO $ LC.sha256Hash <$> LB.readFile testChunkPath + let file = FileInfo {sndKey, size = chSize, digest} + chunkSpec = XFTPChunkSpec {filePath = testChunkPath, chunkOffset = 0, chunkSize = chSize} + (sId, [rId1]) <- createXFTPChunk s spKey file [rcvKey1] Nothing + [rId2, rId3] <- addXFTPRecipients s spKey sId [rcvKey2, rcvKey3] + uploadXFTPChunk s spKey sId chunkSpec + let testReceiveChunk r rpKey rId fPath = do + downloadXFTPChunk g r rpKey rId $ XFTPRcvChunkSpec fPath chSize digest + liftIO $ B.readFile fPath `shouldReturn` bytes + testReceiveChunk r1 rpKey1 rId1 "tests/tmp/received_chunk1" + testReceiveChunk r2 rpKey2 rId2 "tests/tmp/received_chunk2" + testReceiveChunk r3 rpKey3 rId3 "tests/tmp/received_chunk3" + _ -> error "expected 4 handles" + +testFileChunkDeletePg :: Expectation +testFileChunkDeletePg = xftpTestPg $ \c -> runRight_ $ runTestFileChunkDelete c c + +testFileChunkDelete2Pg :: Expectation +testFileChunkDelete2Pg = xftpTestPg2 $ \s r -> runRight_ $ runTestFileChunkDelete s r + +testFileChunkAckPg :: Expectation +testFileChunkAckPg = xftpTestPg $ \c -> runRight_ $ runTestFileChunkAck c c + +testFileChunkAck2Pg :: Expectation +testFileChunkAck2Pg = xftpTestPg2 $ \s r -> runRight_ $ runTestFileChunkAck s r + +testFileStorageQuotaPg :: Expectation +testFileStorageQuotaPg = do + let cfg = testXFTPServerConfig {fileSizeQuota = Just $ chSize * 2} + withXFTPServerCfgStore (XSCDatabase testXFTPPostgresCfg) cfg $ \_ -> + testXFTPClient $ \c -> runRight_ $ do + g <- liftIO C.newRandom + (sndKey, spKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g + (rcvKey, rpKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g + bytes <- liftIO $ createTestChunk testChunkPath + digest <- liftIO $ LC.sha256Hash <$> LB.readFile testChunkPath + let file = FileInfo {sndKey, size = chSize, digest} + chunkSpec = XFTPChunkSpec {filePath = testChunkPath, chunkOffset = 0, chunkSize = chSize} + download rId = do + downloadXFTPChunk g c rpKey rId $ XFTPRcvChunkSpec "tests/tmp/received_chunk1" chSize digest + liftIO $ B.readFile "tests/tmp/received_chunk1" `shouldReturn` bytes + (sId1, [rId1]) <- createXFTPChunk c spKey file [rcvKey] Nothing + uploadXFTPChunk c spKey sId1 chunkSpec + download rId1 + (sId2, [rId2]) <- createXFTPChunk c spKey file [rcvKey] Nothing + uploadXFTPChunk c spKey sId2 chunkSpec + download rId2 + (sId3, [_rId3]) <- createXFTPChunk c spKey file [rcvKey] Nothing + uploadXFTPChunk c spKey sId3 chunkSpec + `catchError` (liftIO . (`shouldBe` PCEProtocolError QUOTA)) + deleteXFTPChunk c spKey sId1 + uploadXFTPChunk c spKey sId3 chunkSpec + +testFileChunkExpirationPg :: Expectation +testFileChunkExpirationPg = + withXFTPServerCfgStore (XSCDatabase testXFTPPostgresCfg) testXFTPServerConfig {fileExpiration} $ \_ -> + testXFTPClient $ \c -> runRight_ $ do + g <- liftIO C.newRandom + (sndKey, spKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g + (rcvKey, rpKey) <- atomically $ C.generateAuthKeyPair C.SEd25519 g + bytes <- liftIO $ createTestChunk testChunkPath + digest <- liftIO $ LC.sha256Hash <$> LB.readFile testChunkPath + let file = FileInfo {sndKey, size = chSize, digest} + chunkSpec = XFTPChunkSpec {filePath = testChunkPath, chunkOffset = 0, chunkSize = chSize} + (sId, [rId]) <- createXFTPChunk c spKey file [rcvKey] Nothing + uploadXFTPChunk c spKey sId chunkSpec + downloadXFTPChunk g c rpKey rId $ XFTPRcvChunkSpec "tests/tmp/received_chunk1" chSize digest + liftIO $ B.readFile "tests/tmp/received_chunk1" `shouldReturn` bytes + liftIO $ threadDelay 1000000 + downloadXFTPChunk g c rpKey rId (XFTPRcvChunkSpec "tests/tmp/received_chunk2" chSize digest) + `catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH)) + deleteXFTPChunk c spKey sId + `catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH)) + where + fileExpiration = Just ExpirationConfig {ttl = 1, checkInterval = 1} +#endif +