{-# 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 :: Int
fileBlockSize = Int
16384

hReceiveFile :: (Int -> IO ByteString) -> Handle -> Word32 -> IO Int64
hReceiveFile :: (Int -> IO ByteString) -> Handle -> Word32 -> IO Int64
hReceiveFile Int -> IO ByteString
_ Handle
_ Word32
0 = Int64 -> IO Int64
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int64
0
hReceiveFile Int -> IO ByteString
getBody Handle
h Word32
size = Int64 -> IO Int64
forall {t}. (Ord t, Num t) => t -> IO t
get (Int64 -> IO Int64) -> Int64 -> IO Int64
forall a b. (a -> b) -> a -> b
$ Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
size
  where
    get :: t -> IO t
get t
sz = do
      ByteString
ch <- Int -> IO ByteString
getBody Int
fileBlockSize
      let chSize :: t
chSize = Int -> t
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> t) -> Int -> t
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
ch
      if
        | t
chSize t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
sz -> t -> IO t
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (t
chSize t -> t -> t
forall a. Num a => a -> a -> a
- t
sz)
        | t
chSize t -> t -> Bool
forall a. Ord a => a -> a -> Bool
> t
0 -> Handle -> ByteString -> IO ()
B.hPut Handle
h ByteString
ch IO () -> IO t -> IO t
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> t -> IO t
get (t
sz t -> t -> t
forall a. Num a => a -> a -> a
- t
chSize)
        | Bool
otherwise -> t -> IO t
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (-t
sz)

hSendFile :: Handle -> (Builder -> IO ()) -> Word32 -> IO ()
hSendFile :: Handle -> (Builder -> IO ()) -> Word32 -> IO ()
hSendFile Handle
h Builder -> IO ()
send = Word32 -> IO ()
go
  where
    go :: Word32 -> IO ()
go Word32
0 = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    go Word32
sz =
      Handle -> Word32 -> IO ByteString
getFileChunk Handle
h Word32
sz IO ByteString -> (ByteString -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ByteString
ch -> do
        Builder -> IO ()
send (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString ByteString
ch
        Word32 -> IO ()
go (Word32 -> IO ()) -> Word32 -> IO ()
forall a b. (a -> b) -> a -> b
$ Word32
sz Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
ch)

getFileChunk :: Handle -> Word32 -> IO ByteString
getFileChunk :: Handle -> Word32 -> IO ByteString
getFileChunk Handle
h Word32
sz = do
  ByteString
ch <- Handle -> Int -> IO ByteString
B.hGet Handle
h Int
fileBlockSize
  if ByteString -> Bool
B.null ByteString
ch
    then IO ByteString
forall a. IO a
ioe_EOF
    else ByteString -> IO ByteString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.take (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
sz) ByteString
ch -- sz >= xftpBlockSize