xftp: add server to client encryption layer with cryptobox (#646)

* xftp: add server to client encryption layer with cryptobox * workarounds for http2 * update http2 commit * remove TODOs
2026-05-14 22:45:06 +00:00 · 2023-02-22 09:03:18 +00:00
parent 50664930cc
commit bbf9e28696
15 changed files with 124 additions and 61 deletions
@@ -15,7 +15,7 @@ source-repository-package
 source-repository-package
    type: git
    location: https://github.com/kazu-yamamoto/http2.git
-    tag: 1136bb126636789cec197e5d0bae39aa63c6f9e5
+    tag: aa56ded3494dd4f0efb0bbcb5378879ce785a647

 source-repository-package
    type: git
@@ -31,10 +31,10 @@ import Simplex.Messaging.Client
    transportClientConfig,
  )
 import qualified Simplex.Messaging.Crypto as C
+import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Protocol
  ( Protocol (..),
    ProtocolServer (..),
-    RcvPublicDhKey,
    RecipientId,
    SenderId,
  )
@@ -142,16 +142,17 @@ uploadXFTPChunk c spKey fId chunkSpec =
    (FROk, _body) -> pure ()
    (r, _) -> throwError . PCEUnexpectedResponse $ bshow r

-downloadXFTPChunk :: XFTPClient -> C.APrivateSignKey -> XFTPFileId -> RcvPublicDhKey -> XFTPRcvChunkSpec -> ExceptT XFTPClientError IO ()
-downloadXFTPChunk c rpKey fId rKey chunkSpec@XFTPRcvChunkSpec {filePath} =
-  sendXFTPCommand c rpKey fId (FGET rKey) Nothing >>= \case
-    (FRFile sKey, HTTP2Body {bodyHead, bodySize, bodyPart}) -> case bodyPart of
+downloadXFTPChunk :: XFTPClient -> C.APrivateSignKey -> XFTPFileId -> XFTPRcvChunkSpec -> ExceptT XFTPClientError IO ()
+downloadXFTPChunk c rpKey fId chunkSpec@XFTPRcvChunkSpec {filePath} = do
+  (rDhKey, rpDhKey) <- liftIO C.generateKeyPair'
+  sendXFTPCommand c rpKey fId (FGET rDhKey) Nothing >>= \case
+    (FRFile sDhKey cbNonce, HTTP2Body {bodyHead, bodySize, bodyPart}) -> case bodyPart of
      -- TODO atm bodySize is set to 0, so chunkSize will be incorrect - validate once set
      Just chunkPart -> do
-        -- let chunk = XFTPChunkBody {chunkSize = bodySize - B.length bodyHead, chunkPart, http2Body}
-        withExceptT PCEResponseError $ do
-          -- TODO chunk decryption
-          receiveFile chunkPart chunkSpec `catchError` \e ->
+        let dhSecret = C.dh' sDhKey rpDhKey
+        cbState <- liftEither . first PCECryptoError $ LC.cbInit dhSecret cbNonce
+        withExceptT PCEResponseError $
+          receiveEncFile chunkPart cbState chunkSpec `catchError` \e ->
            whenM (doesFileExist filePath) (removeFile filePath) >> throwError e
      _ -> throwError $ PCEResponseError NO_FILE
    (r, _) -> throwError . PCEUnexpectedResponse $ bshow r
@@ -332,7 +332,7 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath}
  encPath <- getEncPath tempPath "xftp"
  createDirectory encPath
  a <- atomically $ newXFTPAgent defaultXFTPClientAgentConfig
-  chunkPaths <- pooledForConcurrentlyN 32 chunks $ downloadFileChunk a encPath
+  chunkPaths <- forM chunks $ downloadFileChunk a encPath
  encDigest <- liftIO $ LC.sha512Hash <$> readChunks chunkPaths
  when (encDigest /= unFileDigest digest) $ throwError $ CLIError "File digest mismatch"
  path <- decryptFile chunkPaths key nonce
@@ -346,9 +346,8 @@ cliReceiveFile ReceiveOptions {fileDescription, filePath, retryCount, tempPath}
      let FileChunkReplica {server, rcvId, rcvKey} = replica
      chunkPath <- uniqueCombine encPath $ show chunkNo
      c <- retries $ getXFTPServerClient a server
-      (rKey, rpKey) <- liftIO C.generateKeyPair'
      let chunkSpec = XFTPRcvChunkSpec chunkPath (unFileSize chunkSize) (unFileDigest digest)
-      retries $ downloadXFTPChunk c rcvKey (unChunkReplicaId rcvId) rKey chunkSpec
+      retries $ downloadXFTPChunk c rcvKey (unChunkReplicaId rcvId) chunkSpec
      pure chunkPath
    downloadFileChunk _ _ _ = throwError $ CLIError "chunk has no replicas"
    decryptFile :: [FilePath] -> C.SbKey -> C.CbNonce -> ExceptT CLIError IO FilePath
@@ -251,7 +251,7 @@ instance ProtocolMsgTag FileResponseTag where
 data FileResponse
  = FRSndIds SenderId (NonEmpty RecipientId)
  | FRRcvIds (NonEmpty RecipientId)
-  | FRFile RcvPublicDhKey
+  | FRFile RcvPublicDhKey C.CbNonce
  | FROk
  | FRErr XFTPErrorType
  | FRPong
@@ -262,7 +262,7 @@ instance ProtocolEncoding XFTPErrorType FileResponse where
  encodeProtocol _v = \case
    FRSndIds fId rIds -> e (FRSndIds_, ' ', fId, rIds)
    FRRcvIds rIds -> e (FRRcvIds_, ' ', rIds)
-    FRFile rKey -> e (FRFile_, ' ', rKey)
+    FRFile rDhKey nonce -> e (FRFile_, ' ', rDhKey, nonce)
    FROk -> e FROk_
    FRErr err -> e (FRErr_, ' ', err)
    FRPong -> e FRPong_
@@ -273,7 +273,7 @@ instance ProtocolEncoding XFTPErrorType FileResponse where
  protocolP _v = \case
    FRSndIds_ -> FRSndIds <$> _smpP <*> smpP
    FRRcvIds_ -> FRRcvIds <$> _smpP
-    FRFile_ -> FRFile <$> _smpP
+    FRFile_ -> FRFile <$> _smpP <*> smpP
    FROk_ -> pure FROk
    FRErr_ -> FRErr <$> _smpP
    FRPong_ -> pure FRPong
@@ -313,7 +313,7 @@ data XFTPErrorType
    SIZE
  | -- | incorrent file digest
    DIGEST
-  | -- | no file body
+  | -- | no expected file body in request/response or no file on the server
    NO_FILE
  | -- | unexpected file body
    HAS_FILE
@@ -36,6 +36,7 @@ import Simplex.FileTransfer.Server.Stats
 import Simplex.FileTransfer.Server.Store
 import Simplex.FileTransfer.Transport
 import qualified Simplex.Messaging.Crypto as C
+import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (CorrId, RcvPublicDhKey)
 import Simplex.Messaging.Server (dummyVerifyCmd, verifyCmdSignature)
@@ -122,11 +123,10 @@ xftpServer cfg@XFTPServerConfig {xftpPort, logTLSErrors} started = do
              ]
        threadDelay interval

-- TODO add client DH secret
 data ServerFile = ServerFile
  { filePath :: FilePath,
    fileSize :: Word32,
-    fileDhSecret :: C.DhSecretX25519
+    sbState :: LC.SbState
  }

 processRequest :: HTTP2Request -> M ()
@@ -152,12 +152,13 @@ processRequest HTTP2Request {sessionId, reqBody = body@HTTP2Body {bodyHead}, sen
      where
        streamBody t_ send done = do
          case t_ of
-            Left _ -> send "padding error" -- TODO respond with BLOCK error?
+            Left _ -> do
+              send "padding error" -- TODO respond with BLOCK error?
+              done
            Right t -> do
              send $ byteString t
-              -- TODO chunk encryption
-              forM_ serverFile_ $ \ServerFile {filePath, fileSize, fileDhSecret} ->
-                withFile filePath ReadMode $ \h -> sendFile h send $ fromIntegral fileSize
+              forM_ serverFile_ $ \ServerFile {filePath, fileSize, sbState} -> do
+                withFile filePath ReadMode $ \h -> sendEncFile h send sbState (fromIntegral fileSize)
          done

 data VerificationResult = VRVerified XFTPRequest | VRFailed
@@ -196,7 +197,7 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
    FADD _rcps -> noFile FROk
    FPUT -> (,Nothing) <$> receiveServerFile fr
    FDEL -> noFile FROk
-    FGET dhKey -> sendServerFile fr dhKey
+    FGET rDhKey -> sendServerFile fr rDhKey
    FACK -> noFile FROk
    -- it should never get to the options below, they are passed in other constructors of XFTPRequest
    FNEW _ _ -> noFile $ FRErr INTERNAL
@@ -219,13 +220,16 @@ processXFTPRequest HTTP2Body {bodyPart} = \case
            Left e -> whenM (doesFileExist fPath) (removeFile fPath) $> FRErr e

    sendServerFile :: FileRec -> RcvPublicDhKey -> M (FileResponse, Maybe ServerFile)
-    sendServerFile FileRec {filePath, fileInfo = FileInfo {size}} rKey = do
+    sendServerFile FileRec {filePath, fileInfo = FileInfo {size}} rDhKey = do
      readTVarIO filePath >>= \case
        Just path -> do
-          (sKey, spKey) <- liftIO C.generateKeyPair'
-          let fileDhSecret = C.dh' rKey spKey
-          pure (FRFile sKey, Just ServerFile {filePath = path, fileSize = size, fileDhSecret})
-        _ -> pure (FRErr AUTH, Nothing) -- TODO file-specific errors?
+          (sDhKey, spDhKey) <- liftIO C.generateKeyPair'
+          let dhSecret = C.dh' rDhKey spDhKey
+          cbNonce <- liftIO C.randomCbNonce
+          pure $ case LC.cbInit dhSecret cbNonce of
+            Right sbState -> (FRFile sDhKey cbNonce, Just ServerFile {filePath = path, fileSize = size, sbState})
+            _ -> (FRErr INTERNAL, Nothing)
+        _ -> pure (FRErr NO_FILE, Nothing)

 randomId :: (MonadUnliftIO m, MonadReader XFTPEnv m) => Int -> m ByteString
 randomId n = do
@@ -10,10 +10,15 @@ module Simplex.FileTransfer.Transport
    XFTPRcvChunkSpec (..),
    sendFile,
    receiveFile,
+    sendEncFile,
+    receiveEncFile,
  )
 where

+import Control.Concurrent (threadDelay)
+import qualified Control.Exception as E
 import Control.Monad.Except
+import qualified Data.ByteArray as BA
 import Data.ByteString.Builder (Builder, byteString)
 import Data.ByteString.Char8 (ByteString)
 import qualified Data.ByteString.Char8 as B
@@ -21,6 +26,7 @@ import qualified Data.ByteString.Lazy.Char8 as LB
 import Data.Word (Word32)
 import GHC.IO.Handle.Internals (ioe_EOF)
 import Simplex.FileTransfer.Protocol (XFTPErrorType (..), xftpBlockSize)
+import qualified Simplex.Messaging.Crypto as C
 import qualified Simplex.Messaging.Crypto.Lazy as LC
 import Simplex.Messaging.Version
 import System.IO (Handle, IOMode (..), withFile)
@@ -40,18 +46,33 @@ sendFile h send = go
  where
    go 0 = pure ()
    go sz =
-      B.hGet h xftpBlockSize >>= \case
-        "" -> ioe_EOF
-        ch -> do
-          let ch' = B.take (fromIntegral sz) ch -- sz >= xftpBlockSize
-          send $ byteString ch'
-          go $ sz - fromIntegral (B.length ch')
+      getFileChunk h sz >>= \ch -> do
+        send $ byteString ch
+        go $ sz - fromIntegral (B.length ch)
+
+sendEncFile :: Handle -> (Builder -> IO ()) -> LC.SbState -> Word32 -> IO ()
+sendEncFile h send = go
+  where
+    go sbState 0 = do
+      -- TODO remove padding when HTTP2 issue is fixed
+      let authTag = BA.convert (LC.sbAuth sbState) <> B.replicate (xftpBlockSize - C.authTagSize) '#'
+      send $ byteString authTag
+    go sbState sz =
+      getFileChunk h sz >>= \ch -> do
+        let (encCh, sbState') = LC.sbEncryptChunk sbState ch
+        send (byteString encCh) `E.catch` \(e :: E.SomeException) -> print e >> E.throwIO e
+        -- TODO remove delay when HTTP2 issue is fixed
+        threadDelay 500
+        go sbState' $ sz - fromIntegral (B.length ch)
+
+getFileChunk :: Handle -> Word32 -> IO ByteString
+getFileChunk h sz =
+  B.hGet h xftpBlockSize >>= \case
+    "" -> ioe_EOF
+    ch -> pure $ B.take (fromIntegral sz) ch -- sz >= xftpBlockSize

 receiveFile :: (Int -> IO ByteString) -> XFTPRcvChunkSpec -> ExceptT XFTPErrorType IO ()
-receiveFile getBody XFTPRcvChunkSpec {filePath, chunkSize, chunkDigest} = do
-  ExceptT $ withFile filePath WriteMode (`receive` chunkSize)
-  digest' <- liftIO $ LC.sha512Hash <$> LB.readFile filePath
-  when (digest' /= chunkDigest) $ throwError DIGEST
+receiveFile getBody = receiveFile_ receive
  where
    receive h sz = do
      ch <- getBody xftpBlockSize
@@ -61,3 +82,33 @@ receiveFile getBody XFTPRcvChunkSpec {filePath, chunkSize, chunkDigest} = do
          | chSize > 0 -> B.hPut h ch >> receive h (sz - chSize)
          | sz == 0 -> pure $ Right ()
          | otherwise -> pure $ Left SIZE
+
+receiveEncFile :: (Int -> IO ByteString) -> LC.SbState -> XFTPRcvChunkSpec -> ExceptT XFTPErrorType IO ()
+receiveEncFile getBody = receiveFile_ . receive
+  where
+    receive sbState h sz = do
+      ch <- getBody xftpBlockSize
+      let chSize = fromIntegral $ B.length ch
+      if
+          | chSize > sz + authSz -> pure $ Left SIZE
+          | chSize > 0 -> do
+            let (ch', rest) = B.splitAt (fromIntegral sz) ch
+                (decCh, sbState') = LC.sbDecryptChunk sbState ch'
+                sz' = sz - fromIntegral (B.length ch')
+            B.hPut h decCh
+            if sz' > 0
+              then receive sbState' h sz'
+              else do
+                let tag' = B.take C.authTagSize rest
+                    tagSz = B.length tag'
+                    tag = LC.sbAuth sbState'
+                tag'' <- if tagSz == C.authTagSize then pure tag' else (tag' <>) <$> getBody (C.authTagSize - tagSz)
+                pure $ if BA.constEq tag'' tag then Right () else Left DIGEST
+          | otherwise -> pure $ Left SIZE
+    authSz = fromIntegral C.authTagSize
+
+receiveFile_ :: (Handle -> Word32 -> IO (Either XFTPErrorType ())) -> XFTPRcvChunkSpec -> ExceptT XFTPErrorType IO ()
+receiveFile_ receive XFTPRcvChunkSpec {filePath, chunkSize, chunkDigest} = do
+  ExceptT $ withFile filePath WriteMode (`receive` chunkSize)
+  digest' <- liftIO $ LC.sha512Hash <$> LB.readFile filePath
+  when (digest' /= chunkDigest) $ throwError DIGEST
@@ -592,7 +592,7 @@ protocolClientError protocolError_ host = \case
  PCENetworkError -> BROKER host NETWORK
  PCEIncompatibleHost -> BROKER host HOST
  PCETransportError e -> BROKER host $ TRANSPORT e
-  e@PCESignatureError {} -> INTERNAL $ show e
+  e@PCECryptoError {} -> INTERNAL $ show e
  PCEIOError {} -> BROKER host NETWORK

 data SMPTestStep = TSConnect | TSCreateQueue | TSSecureQueue | TSDeleteQueue | TSDisconnect
@@ -414,8 +414,8 @@ data ProtocolClientError err
  | -- | TCP transport handshake or some other transport error.
    -- Forwarded to the agent client as `ERR BROKER TRANSPORT e`.
    PCETransportError TransportError
-  | -- | Error when cryptographically "signing" the command.
-    PCESignatureError C.CryptoError
+  | -- | Error when cryptographically "signing" the command or when initializing crypto_box.
+    PCECryptoError C.CryptoError
  | -- | IO Error
    PCEIOError IOException
  deriving (Eq, Show, Exception)
@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -11,6 +12,11 @@ module Simplex.Messaging.Crypto.Lazy
    sbEncrypt,
    sbDecrypt,
    fastReplicate,
+    SbState,
+    cbInit,
+    sbEncryptChunk,
+    sbDecryptChunk,
+    sbAuth,
  )
 where

@@ -29,7 +35,7 @@ import qualified Data.ByteString.Lazy.Internal as LB
 import Data.Int (Int64)
 import Data.List.NonEmpty (NonEmpty (..))
 import Foreign (sizeOf)
-import Simplex.Messaging.Crypto (CbNonce, CryptoError (..), SbKey, pattern CbNonce, pattern SbKey)
+import Simplex.Messaging.Crypto (CbNonce, CryptoError (..), DhSecret (..), DhSecretX25519, SbKey, pattern CbNonce, pattern SbKey)
 import Simplex.Messaging.Encoding

 type LazyByteString = LB.ByteString
@@ -92,7 +98,7 @@ sbDecrypt (SbKey key) (CbNonce nonce) packet
    (tag', c) = LB.splitAt 16 packet

 secretBox :: ByteArrayAccess key => (SbState -> ByteString -> (ByteString, SbState)) -> key -> ByteString -> LazyByteString -> Either CryptoError (NonEmpty ByteString)
-secretBox sbProcess secret nonce msg = run <$> sbInit secret nonce
+secretBox sbProcess secret nonce msg = run <$> sbInit_ secret nonce
  where
    process state = foldlChunks update ([], state) msg
    update (cs, st) chunk = let (c, st') = sbProcess st chunk in (c : cs, st')
@@ -100,8 +106,12 @@ secretBox sbProcess secret nonce msg = run <$> sbInit secret nonce

 type SbState = (XSalsa.State, Poly1305.State)

-sbInit :: ByteArrayAccess key => key -> ByteString -> Either CryptoError SbState
-sbInit secret nonce = (state2,) <$> cryptoPassed (Poly1305.initialize rs)
+cbInit :: DhSecretX25519 -> CbNonce -> Either CryptoError SbState
+cbInit (DhSecretX25519 secret) (CbNonce nonce) = sbInit_ secret nonce
+{-# INLINE cbInit #-}
+
+sbInit_ :: ByteArrayAccess key => key -> ByteString -> Either CryptoError SbState
+sbInit_ secret nonce = (state2,) <$> cryptoPassed (Poly1305.initialize rs)
  where
    zero = B.replicate 16 $ toEnum 0
    (iv0, iv1) = B.splitAt 8 nonce
@@ -235,7 +235,7 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
      PCEResponseError e -> updateErr "ResponseError " e
      PCEUnexpectedResponse r -> updateErr "UnexpectedResponse " r
      PCETransportError e -> updateErr "TransportError " e
-      PCESignatureError e -> updateErr "SignatureError " e
+      PCECryptoError e -> updateErr "CryptoError " e
      PCEIncompatibleHost -> updateSubStatus smpQueue $ NSErr "IncompatibleHost"
      PCEResponseTimeout -> pure ()
      PCENetworkError -> pure ()
@@ -343,7 +343,7 @@ apnsPushProviderClient c@APNSPushClient {nonceDrg, apnsCfg} tkn@NtfTknData {toke
  nonce <- atomically $ C.pseudoRandomCbNonce nonceDrg
  apnsNtf <- liftEither $ first PPCryptoError $ apnsNotification tkn nonce (paddedNtfLength apnsCfg) pn
  req <- liftIO $ apnsRequest c tknStr apnsNtf
-  -- TODO if HTTP2 client is thread-safe, we can use sendRequestDirect (the tests pass)
+  -- TODO when HTTP2 client is thread-safe, we can use sendRequestDirect
  HTTP2Response {response, respBody = HTTP2Body {bodyHead}} <- liftHTTPS2 $ sendRequest http2 req
  let status = H.responseStatus response
      reason' = maybe "" reason $ J.decodeStrict' bodyHead
@@ -499,10 +499,8 @@ syntaxTests t = do
  it "unknown command" $ ("1", "5678", "HELLO") >#> ("1", "5678", "ERR CMD SYNTAX")
  describe "NEW" $ do
    describe "valid" $ do
-      -- TODO: add tests with defined connection id
      it "with correct parameter" $ ("211", "", "NEW T INV") >#>= \case ("211", _, "INV" : _) -> True; _ -> False
    describe "invalid" $ do
-      -- TODO: add tests with defined connection id
      it "with incorrect parameter" $ ("222", "", "NEW T hi") >#> ("222", "", "ERR CMD SYNTAX")

  describe "JOIN" $ do
@@ -62,7 +62,6 @@ removeStore db = do
    close :: SQLiteStore -> IO ()
    close st = mapM_ DB.close =<< atomically (tryTakeTMVar $ dbConnection st)

-- TODO add null port tests
 storeTests :: Spec
 storeTests = do
  withStore2 $ do
@@ -279,7 +278,6 @@ testDeleteRcvConn =
      `shouldReturn` Right (SomeConn SCRcv (RcvConnection cData1 rcvQueue1))
    deleteConn db "conn1"
      `shouldReturn` ()
-    -- TODO check queues are deleted as well
    getConn db "conn1"
      `shouldReturn` Left SEConnNotFound

@@ -292,7 +290,6 @@ testDeleteSndConn =
      `shouldReturn` Right (SomeConn SCSnd (SndConnection cData1 sndQueue1))
    deleteConn db "conn1"
      `shouldReturn` ()
-    -- TODO check queues are deleted as well
    getConn db "conn1"
      `shouldReturn` Left SEConnNotFound

@@ -306,7 +303,6 @@ testDeleteDuplexConn =
      `shouldReturn` Right (SomeConn SCDuplex (DuplexConnection cData1 [rcvQueue1] [sndQueue1]))
    deleteConn db "conn1"
      `shouldReturn` ()
-    -- TODO check queues are deleted as well
    getConn db "conn1"
      `shouldReturn` Left SEConnNotFound

@@ -2,6 +2,7 @@ module XFTPCLI where

 import Control.Exception (bracket_)
 import qualified Data.ByteString as LB
+import Data.List (isInfixOf)
 import Simplex.FileTransfer.Client.Main (xftpClientCLI)
 import System.Directory (createDirectoryIfMissing, getFileSize, removeDirectoryRecursive)
 import System.Environment (withArgs)
@@ -68,11 +69,15 @@ testXFTPCLISendReceive2servers = withXFTPServer . withXFTPServer2 $ do
  where
    xftp params = lines <$> capture_ (withArgs params xftpClientCLI)
    testReceiveFile fd fileName file = do
-      [sizeStr, srvStr, srv1Str, srv2Str] <- xftp ["info", fd]
+      sizeStr : srvStr : srvs <- xftp ["info", fd]
      sizeStr `shouldBe` "File download size: 20mb"
      srvStr `shouldBe` "File server(s):"
-      srv1Str `shouldContain` testXFTPServerStr
-      srv2Str `shouldContain` testXFTPServerStr2
+      case srvs of
+        [srv1] -> any (`isInfixOf` srv1) [testXFTPServerStr, testXFTPServerStr2] `shouldBe` True
+        [srv1, srv2] -> do
+          srv1 `shouldContain` testXFTPServerStr
+          srv2 `shouldContain` testXFTPServerStr2
+        _ -> print srvs >> error "more than 2 servers returned"
      xftp ["recv", fd, recipientFiles, "--tmp=tests/tmp"]
        `shouldReturn` ["File received: " <> recipientFiles </> fileName]
      LB.readFile (recipientFiles </> fileName) `shouldReturn` file
@@ -34,7 +34,7 @@ xftpServerTests =
        it "should create, upload and receive file chunk (2 clients)" testFileChunkDelivery2

 chSize :: Num n => n
-chSize = 256 * 1024
+chSize = 128 * 1024

 testChunkPath :: FilePath
 testChunkPath = "tests/tmp/chunk1"
@@ -58,7 +58,6 @@ runTestFileChunkDelivery :: XFTPClient -> XFTPClient -> ExceptT XFTPClientError
 runTestFileChunkDelivery s r = do
  (sndKey, spKey) <- liftIO $ C.generateSignatureKeyPair C.SEd25519
  (rcvKey, rpKey) <- liftIO $ C.generateSignatureKeyPair C.SEd25519
-  (rDhKey, _rpDhKey) <- liftIO C.generateKeyPair'
  bytes <- liftIO $ createTestChunk testChunkPath
  digest <- liftIO $ LC.sha512Hash <$> LB.readFile testChunkPath
  let file = FileInfo {sndKey, size = chSize, digest}
@@ -69,7 +68,7 @@ runTestFileChunkDelivery s r = do
  uploadXFTPChunk s spKey sId' chunkSpec
    `catchError` (liftIO . (`shouldBe` PCEProtocolError DIGEST))
  liftIO $ readChunk sId `shouldReturn` bytes
-  downloadXFTPChunk r rpKey rId rDhKey (XFTPRcvChunkSpec "tests/tmp/received_chunk1" chSize (digest <> "_wrong"))
+  downloadXFTPChunk r rpKey rId (XFTPRcvChunkSpec "tests/tmp/received_chunk1" chSize (digest <> "_wrong"))
    `catchError` (liftIO . (`shouldBe` PCEResponseError DIGEST))
-  downloadXFTPChunk r rpKey rId rDhKey $ XFTPRcvChunkSpec "tests/tmp/received_chunk1" chSize digest
+  downloadXFTPChunk r rpKey rId $ XFTPRcvChunkSpec "tests/tmp/received_chunk1" chSize digest
  liftIO $ B.readFile "tests/tmp/received_chunk1" `shouldReturn` bytes