From decf25d7dccf034e9853e9ca04e4bc730f91c103 Mon Sep 17 00:00:00 2001 From: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com> Date: Thu, 19 Oct 2023 10:25:21 +0100 Subject: [PATCH] refactor http2 file (#864) * refactor http2 file * move fileBlockSize to HTTP2.File --- simplexmq.cabal | 1 + src/Simplex/FileTransfer/Client.hs | 3 +- src/Simplex/FileTransfer/Transport.hs | 31 +------------ src/Simplex/Messaging/Transport/HTTP2/File.hs | 43 +++++++++++++++++++ 4 files changed, 48 insertions(+), 30 deletions(-) create mode 100644 src/Simplex/Messaging/Transport/HTTP2/File.hs diff --git a/simplexmq.cabal b/simplexmq.cabal index 84706cce5..7ebbb8c6e 100644 --- a/simplexmq.cabal +++ b/simplexmq.cabal @@ -133,6 +133,7 @@ library Simplex.Messaging.Transport.Credentials Simplex.Messaging.Transport.HTTP2 Simplex.Messaging.Transport.HTTP2.Client + Simplex.Messaging.Transport.HTTP2.File Simplex.Messaging.Transport.HTTP2.Server Simplex.Messaging.Transport.KeepAlive Simplex.Messaging.Transport.Server diff --git a/src/Simplex/FileTransfer/Client.hs b/src/Simplex/FileTransfer/Client.hs index fcf0debde..04e6ff429 100644 --- a/src/Simplex/FileTransfer/Client.hs +++ b/src/Simplex/FileTransfer/Client.hs @@ -49,6 +49,7 @@ import Simplex.Messaging.Transport (supportedParameters) import Simplex.Messaging.Transport.Client (TransportClientConfig, TransportHost) import Simplex.Messaging.Transport.HTTP2 import Simplex.Messaging.Transport.HTTP2.Client +import Simplex.Messaging.Transport.HTTP2.File import Simplex.Messaging.Util (bshow, liftEitherError, whenM) import UnliftIO import UnliftIO.Directory @@ -153,7 +154,7 @@ sendXFTPCommand XFTPClient {config, http2Client = http2@HTTP2Client {sessionId}} forM_ chunkSpec_ $ \XFTPChunkSpec {filePath, chunkOffset, chunkSize} -> withFile filePath ReadMode $ \h -> do hSeek h AbsoluteSeek $ fromIntegral chunkOffset - sendFile h send $ fromIntegral chunkSize + hSendFile h send $ fromIntegral chunkSize done createXFTPChunk :: diff --git a/src/Simplex/FileTransfer/Transport.hs b/src/Simplex/FileTransfer/Transport.hs index 219fd4718..94f0a3e5d 100644 --- a/src/Simplex/FileTransfer/Transport.hs +++ b/src/Simplex/FileTransfer/Transport.hs @@ -1,5 +1,4 @@ {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} @@ -8,7 +7,6 @@ module Simplex.FileTransfer.Transport ( supportedFileServerVRange, XFTPRcvChunkSpec (..), - sendFile, receiveFile, sendEncFile, receiveEncFile, @@ -25,11 +23,11 @@ import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as LB import Data.Word (Word32) -import GHC.IO.Handle.Internals (ioe_EOF) import Simplex.FileTransfer.Protocol (XFTPErrorType (..)) import qualified Simplex.Messaging.Crypto as C import qualified Simplex.Messaging.Crypto.Lazy as LC import Simplex.Messaging.Version +import Simplex.Messaging.Transport.HTTP2.File import System.IO (Handle, IOMode (..), withFile) data XFTPRcvChunkSpec = XFTPRcvChunkSpec @@ -42,18 +40,6 @@ data XFTPRcvChunkSpec = XFTPRcvChunkSpec supportedFileServerVRange :: VersionRange supportedFileServerVRange = mkVersionRange 1 1 -fileBlockSize :: Int -fileBlockSize = 16 * 1024 - -sendFile :: Handle -> (Builder -> IO ()) -> Word32 -> IO () -sendFile h send = go - where - go 0 = pure () - go sz = - 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 @@ -66,23 +52,10 @@ sendEncFile h send = go send (byteString encCh) `E.catch` \(e :: E.SomeException) -> print e >> E.throwIO e go sbState' $ sz - fromIntegral (B.length ch) -getFileChunk :: Handle -> Word32 -> IO ByteString -getFileChunk h sz = - B.hGet h fileBlockSize >>= \case - "" -> ioe_EOF - ch -> pure $ B.take (fromIntegral sz) ch -- sz >= xftpBlockSize - receiveFile :: (Int -> IO ByteString) -> XFTPRcvChunkSpec -> ExceptT XFTPErrorType IO () receiveFile getBody = receiveFile_ receive where - receive h sz = do - ch <- getBody fileBlockSize - let chSize = fromIntegral $ B.length ch - if - | chSize > sz -> pure $ Left SIZE - | chSize > 0 -> B.hPut h ch >> receive h (sz - chSize) - | sz == 0 -> pure $ Right () - | otherwise -> pure $ Left SIZE + receive h sz = hReceiveFile getBody h sz >>= \sz' -> pure $ if sz' == 0 then Right () else Left SIZE receiveEncFile :: (Int -> IO ByteString) -> LC.SbState -> XFTPRcvChunkSpec -> ExceptT XFTPErrorType IO () receiveEncFile getBody = receiveFile_ . receive diff --git a/src/Simplex/Messaging/Transport/HTTP2/File.hs b/src/Simplex/Messaging/Transport/HTTP2/File.hs new file mode 100644 index 000000000..a0a6aadad --- /dev/null +++ b/src/Simplex/Messaging/Transport/HTTP2/File.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} + +module Simplex.Messaging.Transport.HTTP2.File where + +import Data.ByteString.Builder (Builder, byteString) +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.Int (Int64) +import Data.Word (Word32) +import GHC.IO.Handle.Internals (ioe_EOF) +import System.IO (Handle) + +fileBlockSize :: Int +fileBlockSize = 16384 + +hReceiveFile :: (Int -> IO ByteString) -> Handle -> Word32 -> IO Int64 +hReceiveFile _ _ 0 = pure 0 +hReceiveFile getBody h size = get $ fromIntegral size + where + get sz = do + ch <- getBody fileBlockSize + let chSize = fromIntegral $ B.length ch + if + | chSize > sz -> pure (chSize - sz) + | chSize > 0 -> B.hPut h ch >> get (sz - chSize) + | otherwise -> pure (- fromIntegral sz) + +hSendFile :: Handle -> (Builder -> IO ()) -> Word32 -> IO () +hSendFile h send = go + where + go 0 = pure () + go sz = + getFileChunk h sz >>= \ch -> do + send $ byteString ch + go $ sz - fromIntegral (B.length ch) + +getFileChunk :: Handle -> Word32 -> IO ByteString +getFileChunk h sz = do + ch <- B.hGet h fileBlockSize + if B.null ch + then ioe_EOF + else pure $ B.take (fromIntegral sz) ch -- sz >= xftpBlockSize