Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 0 additions & 8 deletions src/Simplex/FileTransfer/Client/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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) <> "%"
Expand Down
13 changes: 7 additions & 6 deletions src/Simplex/FileTransfer/Server.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
51 changes: 1 addition & 50 deletions tests/XFTPServerTests.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
Loading