7.1.0.6

* xftp server: disable ack

* fix tests

---------

Co-authored-by: Evgeny @ SimpleX Chat <[email protected]>

simplexmq.cabal

@@ -1,7 +1,7 @@
 cabal-version: 3.0
 
 name:           simplexmq
-version:        7.1.0.5
+version:        7.1.0.6
 synopsis:       SimpleXMQ message broker
 description:    This package includes <./docs/Simplex-Messaging-Server.html server>,
                 <./docs/Simplex-Messaging-Client.html client> and

src/Simplex/FileTransfer/Client/Main.hs

@@ -441,7 +441,6 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
           | depth > 0 -> do
               CryptoFile tmpFile _ <- withExceptT cliCryptoError $ decryptChunks encSize chunkPaths key nonce $ \_ ->
                 fmap CF.plain $ uniqueCombine encPath "redirect.yaml"
-              forM_ chunks $ acknowledgeFileChunk a
               yaml <- liftIO $ B.readFile tmpFile
               whenM (doesPathExist encPath) $ removeDirectoryRecursive encPath
               innerVfd <- either (throwE . CLIError . ("Redirect: invalid file description: " <>)) pure $ strDecode yaml
@@ -450,7 +449,6 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
         Nothing -> do
           liftIO $ printNoNewLine "Decrypting file..."
           CryptoFile path _ <- withExceptT cliCryptoError $ decryptChunks encSize chunkPaths key nonce $ fmap CF.plain . getFilePath
-          forM_ chunks $ acknowledgeFileChunk a
           whenM (doesPathExist encPath) $ removeDirectoryRecursive encPath
           liftIO $ do
             printNoNewLine $ "File downloaded: " <> path
@@ -479,12 +477,6 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath,
       _ -> (`uniqueCombine` name') . (</> "Downloads") =<< getHomeDirectory
       where
         name' = T.unpack name
-    acknowledgeFileChunk :: XFTPClientAgent -> FileChunk -> ExceptT CLIError IO ()
-    acknowledgeFileChunk a FileChunk {replicas = replica : _} = do
-      let FileChunkReplica {server, replicaId, replicaKey} = replica
-      c <- withRetry retryCount $ getXFTPServerClient a server
-      withRetry retryCount $ ackXFTPChunk c replicaKey (unChunkReplicaId replicaId)
-    acknowledgeFileChunk _ _ = throwE $ CLIError "chunk has no replicas"
 
 printProgress :: String -> Int64 -> Int64 -> IO ()
 printProgress s part total = printNoNewLine $ s <> " " <> show ((part * 100) `div` total) <> "%"

src/Simplex/FileTransfer/Description.hs

@@ -29,6 +29,7 @@ module Simplex.FileTransfer.Description
     YAMLFileDescription (..), -- for tests
     YAMLServerReplicas (..), -- for tests
     validateFileDescription,
+    sharedDescriptionHash,
     groupReplicasByServer,
     fdSeparator,
     kb,
@@ -72,6 +73,7 @@ import Simplex.FileTransfer.Protocol
 import Simplex.Messaging.Agent.QueryString
 import Simplex.Messaging.Agent.Store.DB (Binary (..), FromField (..), ToField (..))
 import qualified Simplex.Messaging.Crypto as C
+import Simplex.Messaging.Encoding (Encoding (..))
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (defaultJSON, parseAll)
 import Simplex.Messaging.Protocol (XFTPServer)
@@ -227,6 +229,13 @@ validateFileDescription fd@FileDescription {size, chunks}
     chunkNos = map (\FileChunk {chunkNo} -> chunkNo) chunks
     chunksSize = foldl' (\(s :: Int64) FileChunk {chunkSize} -> s + fromIntegral (unFileSize chunkSize)) 0
 
+sharedDescriptionHash :: FileDescription p -> ByteString
+sharedDescriptionHash FileDescription {size, digest, key, nonce, chunkSize, chunks} =
+  C.sha512Hash $ smpEncode (unFileSize size, unFileDigest digest, C.unSbKey key, nonce, unFileSize chunkSize) <> foldMap chunkFields chunks
+  where
+    chunkFields FileChunk {chunkNo, chunkSize = cSize, digest = cDigest} =
+      smpEncode (fromIntegral chunkNo :: Int64, unFileSize cSize, unFileDigest cDigest)
+
 encodeFileDescription :: FileDescription p -> YAMLFileDescription
 encodeFileDescription FileDescription {party, size, digest, key, nonce, chunkSize, chunks, redirect} =
   YAMLFileDescription

src/Simplex/FileTransfer/Server.hs

@@ -63,7 +63,7 @@ import Simplex.Messaging.Crypto.Entitlement (Entitlement (..), EntitlementProof
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding
 import Simplex.Messaging.Encoding.String
-import Simplex.Messaging.Protocol (BlockingInfo, EntityId (..), RcvPublicAuthKey, RcvPublicDhKey, RecipientId, SignedTransmission, pattern NoEntity)
+import Simplex.Messaging.Protocol (BlockingInfo, CommandError (..), EntityId (..), RcvPublicAuthKey, RcvPublicDhKey, RecipientId, SignedTransmission, pattern NoEntity)
 import Simplex.Messaging.Server (controlPortAuth, dummyVerifyCmd, verifyCmdAuthorization)
 import Simplex.Messaging.Server.Control (CPClientRole (..))
 import Simplex.Messaging.Server.Expiration
@@ -646,11 +646,12 @@ processXFTPRequest ent HTTP2Body {bodyPart} = \case
 
     ackFileReception :: RecipientId -> FileRec -> M s FileResponse
     ackFileReception rId fr = do
-      withFileLog (`logAckFile` rId)
-      st <- asks fileStore
-      liftIO $ deleteRecipient st rId fr
-      incFileStat fileDownloadAcks
-      pure FROk
+      pure $ FRErr $ CMD PROHIBITED
+      -- withFileLog (`logAckFile` rId)
+      -- st <- asks fileStore
+      -- liftIO $ deleteRecipient st rId fr
+      -- incFileStat fileDownloadAcks
+      -- pure FROk
 
 deleteServerFile_ :: FileStoreClass s => FileRec -> M s (Either XFTPErrorType ())
 deleteServerFile_ fr@FileRec {senderId} = do

tests/XFTPServerTests.hs

@@ -63,8 +63,6 @@ xftpServerTests =
       it "should create, add recipients, upload and receive file chunk" testFileChunkDeliveryAddRecipients
       it "should delete file chunk (1 client)" testFileChunkDelete
       it "should delete file chunk (2 clients)" testFileChunkDelete2
-      it "should acknowledge file chunk reception (1 client)" testFileChunkAck
-      it "should acknowledge file chunk reception (2 clients)" testFileChunkAck2
       it "should not allow chunks of wrong size" testWrongChunkSize
       it "should expire chunks after set interval" testFileChunkExpiration
       it "should disconnect inactive clients" testInactiveClientExpiration
@@ -184,33 +182,6 @@ runTestFileChunkDelete s r = do
   deleteXFTPChunk s spKey sId
     `catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
 
-testFileChunkAck :: AFStoreType -> Expectation
-testFileChunkAck = xftpTest $ \c -> runRight_ $ runTestFileChunkAck c c
-
-testFileChunkAck2 :: AFStoreType -> Expectation
-testFileChunkAck2 = xftpTest2 $ \s r -> runRight_ $ runTestFileChunkAck s r
-
-runTestFileChunkAck :: XFTPClient -> XFTPClient -> ExceptT XFTPClientError IO ()
-runTestFileChunkAck s r = 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 s spKey file [rcvKey] Nothing
-  uploadXFTPChunk s spKey sId chunkSpec
-
-  downloadXFTPChunk g r rpKey rId $ XFTPRcvChunkSpec "tests/tmp/received_chunk1" chSize digest
-  liftIO $ B.readFile "tests/tmp/received_chunk1" `shouldReturn` bytes
-  ackXFTPChunk r rpKey rId
-  liftIO $ readChunk sId `shouldReturn` bytes
-  downloadXFTPChunk g r rpKey rId (XFTPRcvChunkSpec "tests/tmp/received_chunk2" chSize digest)
-    `catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
-  ackXFTPChunk r rpKey rId
-    `catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
-
 testWrongChunkSize :: AFStoreType -> Expectation
 testWrongChunkSize = xftpTest $ \c -> do
   g <- C.newRandom
@@ -336,32 +307,12 @@ testFileLog _ = do
 
   threadDelay 100000
 
-  withXFTPServerStoreLogOn $ \_ -> testXFTPClient $ \c -> runRight_ $ do
-    rId1 <- liftIO $ readTVarIO rIdVar1
-    rId2 <- liftIO $ readTVarIO rIdVar2
-    -- recipient 1 can download, acknowledges - +1 to log
-    download g c rpKey1 rId1 digest bytes
-    ackXFTPChunk c rpKey1 rId1
-    -- recipient 2 can download
-    download g c rpKey2 rId2 digest bytes
-  logSize testXFTPLogFile `shouldReturn` 4
-  logSize testXFTPStatsBackupFile `shouldReturn` 15
-
-  threadDelay 100000
-
-  withXFTPServerStoreLogOn $ \_ -> pure () -- ack is compacted - -1 from log
-  logSize testXFTPLogFile `shouldReturn` 3
-
-  threadDelay 100000
-
   withXFTPServerStoreLogOn $ \_ -> testXFTPClient $ \c -> runRight_ $ do
     sId <- liftIO $ readTVarIO sIdVar
     rId1 <- liftIO $ readTVarIO rIdVar1
     rId2 <- liftIO $ readTVarIO rIdVar2
-    -- recipient 1 can't download due to previous acknowledgement
+    -- recipients can download
     download g c rpKey1 rId1 digest bytes
-      `catchError` (liftIO . (`shouldBe` PCEProtocolError AUTH))
-    -- recipient 2 can download
     download g c rpKey2 rId2 digest bytes
     -- sender can delete - +1 to log
     deleteXFTPChunk c spKey sId