diff --git a/src/Simplex/FileTransfer/Server/StoreLog.hs b/src/Simplex/FileTransfer/Server/StoreLog.hs index 656d31904..c6f792943 100644 --- a/src/Simplex/FileTransfer/Server/StoreLog.hs +++ b/src/Simplex/FileTransfer/Server/StoreLog.hs @@ -20,7 +20,7 @@ module Simplex.FileTransfer.Server.StoreLog ) where -import Control.Applicative ((<|>)) +import Control.Applicative (optional, (<|>)) import Control.Concurrent.STM import Control.Monad.Except import qualified Data.Attoparsec.ByteString.Char8 as A @@ -52,7 +52,7 @@ data FileStoreLogRecord instance StrEncoding FileStoreLogRecord where strEncode = \case - AddFile sId file createdAt expiresAt status -> strEncode (Str "FNEW", sId, file, createdAt, status) <> expE expiresAt + AddFile sId file createdAt expiresAt status -> B.concat [strEncode (Str "FNEW", sId, file, createdAt), expE expiresAt, " ", strEncode status] PutFile sId path -> strEncode (Str "FPUT", sId, path) AddRecipients sId rcps -> strEncode (Str "FADD", sId, rcps) DeleteFile sId -> strEncode (Str "FDEL", sId) @@ -74,8 +74,8 @@ instance StrEncoding FileStoreLogRecord where sId <- strP_ file <- strP_ createdAt <- strP + expiresAt <- optional _strP status <- _strP <|> pure EntityActive - expiresAt <- (A.space *> (Just <$> strP)) <|> pure Nothing pure $ AddFile sId file createdAt expiresAt status logFileStoreRecord :: StoreLog 'WriteMode -> FileStoreLogRecord -> IO () diff --git a/tests/CoreTests/StoreLogTests.hs b/tests/CoreTests/StoreLogTests.hs index 01966ba05..1b59430a3 100644 --- a/tests/CoreTests/StoreLogTests.hs +++ b/tests/CoreTests/StoreLogTests.hs @@ -20,9 +20,13 @@ import qualified Data.Map.Strict as M import qualified Data.X509 as X import qualified Data.X509.Validation as XV import SMPClient +import Simplex.FileTransfer.Protocol (FileInfo (..)) +import Simplex.FileTransfer.Server.Store (FileRec (..), FileRecipient (..), FileStoreClass (..), RoundedFileTime, STMFileStore (..)) +import Simplex.FileTransfer.Server.StoreLog (FileStoreLogRecord (..), readWriteFileStore) import qualified Simplex.Messaging.Crypto as C import Simplex.Messaging.Encoding.String import Simplex.Messaging.Protocol +import Simplex.Messaging.Protocol.Types (ClientNotice (..)) import Simplex.Messaging.Server.Env.STM (readWriteQueueStore) import Simplex.Messaging.Server.MsgStore.Journal import Simplex.Messaging.Server.MsgStore.Types @@ -191,3 +195,75 @@ testSMPStoreLog testSuite tests = compacted' `shouldBe` compacted storeState :: JournalMsgStore 'QSMemory -> IO (M.Map RecipientId QueueRec) storeState st = M.mapMaybe id <$> (readTVarIO (queues $ stmQueueStore st) >>= mapM (readTVarIO . queueRec)) + +type FileRecState = (FileInfo, RoundedFileTime, Maybe RoundedFileTime, ServerEntityStatus) + +type XFTPStoreLogTestCase = StoreLogTestCase FileStoreLogRecord (M.Map SenderId FileRecState) + +deriving instance Eq FileInfo + +deriving instance Eq FileRecipient + +deriving instance Eq FileStoreLogRecord + +testFileStoreLogFile :: FilePath +testFileStoreLogFile = "tests/tmp/xftp-server-store.log" + +fileStoreLogTests :: Spec +fileStoreLogTests = do + g <- runIO C.newRandom + (sndKey, _) <- runIO $ atomically $ C.generateAuthKeyPair C.SEd25519 g + sId <- runIO $ atomically $ EntityId <$> C.randomBytes 24 g + let file = FileInfo {sndKey, size = 16384, digest = "12345678"} + createdAt = RoundedSystemTime 1600000000 + expiresAt = RoundedSystemTime 1600172800 + blocked = BlockingInfo {reason = BRSpam, notice = Nothing} + blockedWithNotice = BlockingInfo {reason = BRContent, notice = Just ClientNotice {ttl = Just 86400}} + testXFTPStoreLog + "XFTP server store log" + [ SLTC + { name = "create file", + saved = [AddFile sId file createdAt (Just expiresAt) EntityActive], + compacted = [AddFile sId file createdAt (Just expiresAt) EntityActive], + state = M.fromList [(sId, (file, createdAt, Just expiresAt, EntityActive))] + }, + SLTC + { name = "create file without expiration", + saved = [AddFile sId file createdAt Nothing EntityActive], + compacted = [AddFile sId file createdAt Nothing EntityActive], + state = M.fromList [(sId, (file, createdAt, Nothing, EntityActive))] + }, + SLTC + { name = "create and block file", + saved = [AddFile sId file createdAt (Just expiresAt) EntityActive, BlockFile sId blocked], + compacted = [AddFile sId file createdAt (Just expiresAt) (EntityBlocked blocked)], + state = M.fromList [(sId, (file, createdAt, Just expiresAt, EntityBlocked blocked))] + }, + SLTC + { name = "create and block file with notice", + saved = [AddFile sId file createdAt (Just expiresAt) EntityActive, BlockFile sId blockedWithNotice], + compacted = [AddFile sId file createdAt (Just expiresAt) (EntityBlocked blockedWithNotice)], + state = M.fromList [(sId, (file, createdAt, Just expiresAt, EntityBlocked blockedWithNotice))] + } + ] + +testXFTPStoreLog :: String -> [XFTPStoreLogTestCase] -> Spec +testXFTPStoreLog testSuite tests = + describe testSuite $ forM_ tests $ \t@SLTC {name, saved} -> it name $ do + l <- openWriteStoreLog False testFileStoreLogFile + mapM_ (writeStoreLogRecord l) saved + closeStoreLog l + replicateM_ 3 $ testReadWrite t + where + testReadWrite SLTC {compacted, state} = do + st <- newFileStore () :: IO STMFileStore + l <- readWriteFileStore testFileStoreLogFile st + storeState st `shouldReturn` state + closeStoreLog l + ([], compacted') <- partitionEithers . map strDecode . B.lines <$> B.readFile testFileStoreLogFile + compacted' `shouldBe` compacted + storeState :: STMFileStore -> IO (M.Map SenderId FileRecState) + storeState st = readTVarIO (files st) >>= mapM fileState + fileState FileRec {fileInfo, createdAt, expiresAt, fileStatus} = do + status <- readTVarIO fileStatus + pure (fileInfo, createdAt, expiresAt, status) diff --git a/tests/Test.hs b/tests/Test.hs index c2968828b..77229a28f 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -97,6 +97,7 @@ main = do #else describe "Store log tests" storeLogTests #endif + describe "XFTP store log tests" fileStoreLogTests describe "TSessionSubs tests" tSessionSubsTests describe "Util tests" utilTests describe "Names resolver tests" smpNamesTests