diff --git a/cabal.project b/cabal.project index 409d98cd6..a0a131f76 100644 --- a/cabal.project +++ b/cabal.project @@ -1,6 +1,7 @@ packages: . -- packages: . ../direct-sqlcipher ../sqlcipher-simple -- packages: . ../hs-socks +-- packages: . ../http2 source-repository-package type: git @@ -15,7 +16,7 @@ source-repository-package source-repository-package type: git location: https://github.com/kazu-yamamoto/http2.git - tag: b3b903e8130a7172b8dfa18b67bcc59620fc0ca0 + tag: b5a1b7200cf5bc7044af34ba325284271f6dff25 source-repository-package type: git diff --git a/src/Simplex/FileTransfer/Client.hs b/src/Simplex/FileTransfer/Client.hs index 79f97e32a..4e0499f41 100644 --- a/src/Simplex/FileTransfer/Client.hs +++ b/src/Simplex/FileTransfer/Client.hs @@ -59,7 +59,7 @@ data XFTPClient = XFTPClient data XFTPClientConfig = XFTPClientConfig { xftpNetworkConfig :: NetworkConfig, - uploadTimeoutPerMb :: Int + uploadTimeoutPerMb :: Int64 } data XFTPChunkBody = XFTPChunkBody @@ -134,7 +134,7 @@ sendXFTPCommand XFTPClient {config, http2Client = http2@HTTP2Client {sessionId}} liftEither . first PCETransportError $ xftpEncodeTransmission sessionId (Just pKey) ("", fId, FileCmd (sFileParty @p) cmd) let req = H.requestStreaming N.methodPost "/" [] $ streamBody t - reqTimeout = (\XFTPChunkSpec {chunkSize} -> (fromIntegral chunkSize * uploadTimeoutPerMb config) `div` mb 1) <$> chunkSpec_ + reqTimeout = (\XFTPChunkSpec {chunkSize} -> chunkTimeout config chunkSize) <$> chunkSpec_ HTTP2Response {respBody = body@HTTP2Body {bodyHead}} <- liftEitherError xftpClientError $ sendRequest http2 req reqTimeout when (B.length bodyHead /= xftpBlockSize) $ throwError $ PCEResponseError BLOCK -- TODO validate that the file ID is the same as in the request? @@ -185,7 +185,7 @@ downloadXFTPChunk c@XFTPClient {config} rpKey fId chunkSpec@XFTPRcvChunkSpec {fi Just chunkPart -> do let dhSecret = C.dh' sDhKey rpDhKey cbState <- liftEither . first PCECryptoError $ LC.cbInit dhSecret cbNonce - let t = (fromIntegral chunkSize * uploadTimeoutPerMb config) `div` mb 1 + let t = chunkTimeout config chunkSize t `timeout` download cbState >>= maybe (throwError PCEResponseTimeout) pure where download cbState = @@ -195,6 +195,9 @@ downloadXFTPChunk c@XFTPClient {config} rpKey fId chunkSpec@XFTPRcvChunkSpec {fi _ -> throwError $ PCEResponseError NO_FILE (r, _) -> throwError . PCEUnexpectedResponse $ bshow r +chunkTimeout :: XFTPClientConfig -> Word32 -> Int +chunkTimeout config chunkSize = fromIntegral $ (fromIntegral chunkSize * uploadTimeoutPerMb config) `div` mb 1 + deleteXFTPChunk :: XFTPClient -> C.APrivateSignKey -> SenderId -> ExceptT XFTPClientError IO () deleteXFTPChunk c spKey sId = sendXFTPCommand c spKey sId FDEL Nothing >>= okResponse diff --git a/src/Simplex/FileTransfer/Client/Main.hs b/src/Simplex/FileTransfer/Client/Main.hs index 7f9186c73..3b9a838de 100644 --- a/src/Simplex/FileTransfer/Client/Main.hs +++ b/src/Simplex/FileTransfer/Client/Main.hs @@ -139,7 +139,7 @@ newtype InfoOptions = InfoOptions data RandomFileOptions = RandomFileOptions { filePath :: FilePath, - fileSize :: FileSize Int + fileSize :: FileSize Int64 } deriving (Show) @@ -586,7 +586,7 @@ cliRandomFile RandomFileOptions {filePath, fileSize = FileSize size} = do putStrLn $ "File created: " <> filePath where saveRandomFile h sz = do - bytes <- getRandomBytes $ min mb' sz + bytes <- getRandomBytes $ fromIntegral $ min mb' sz B.hPut h bytes when (sz > mb') $ saveRandomFile h (sz - mb') mb' = mb 1 diff --git a/stack.yaml b/stack.yaml index f5ee2e7fc..5b2bd9baf 100644 --- a/stack.yaml +++ b/stack.yaml @@ -49,7 +49,7 @@ extra-deps: - github: simplex-chat/aeson commit: 3eb66f9a68f103b5f1489382aad89f5712a64db7 - github: kazu-yamamoto/http2 - commit: b3b903e8130a7172b8dfa18b67bcc59620fc0ca0 + commit: b5a1b7200cf5bc7044af34ba325284271f6dff25 # - ../direct-sqlcipher - github: simplex-chat/direct-sqlcipher commit: 34309410eb2069b029b8fc1872deb1e0db123294 diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs index 44c147b1e..83d973015 100644 --- a/tests/AgentTests/NotificationTests.hs +++ b/tests/AgentTests/NotificationTests.hs @@ -34,7 +34,6 @@ import qualified Simplex.Messaging.Protocol as SMP import Simplex.Messaging.Transport (ATransport) import Simplex.Messaging.Util (tryE) import System.Directory (doesFileExist, removeFile) -import System.Info (os) import Test.Hspec import UnliftIO