mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-04-08 08:25:54 +00:00
f3408d9bb6
* explicit exports * more empty exports * add exports * reorder * use correct ControlProtocol type for xftp router --------- Co-authored-by: Evgeny @ SimpleX Chat <259188159+evgeny-simplex@users.noreply.github.com>
48 lines
1.3 KiB
Haskell
48 lines
1.3 KiB
Haskell
{-# LANGUAGE MultiWayIf #-}
|
|
|
|
module Simplex.Messaging.Transport.HTTP2.File
|
|
( fileBlockSize,
|
|
hReceiveFile,
|
|
hSendFile,
|
|
getFileChunk,
|
|
) where
|
|
|
|
import Data.ByteString (ByteString)
|
|
import qualified Data.ByteString as B
|
|
import Data.ByteString.Builder (Builder, byteString)
|
|
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 (-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
|