{-# LANGUAGE OverloadedStrings #-}

module Network.HTTP3.Send (
    sendHeader
  , sendBody
  ) where

import Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder.Extra as B
import qualified Data.ByteString.Internal as BS
import Data.IORef
import Foreign.ForeignPtr
import Network.HPACK (toHeaderTable)
import qualified Network.HTTP.Types as HT
import Network.HTTP2.Internal
import Network.QUIC
import qualified System.TimeManager as T

import Imports
import Network.HTTP3.Context
import Network.HTTP3.Frame

sendHeader :: Context -> Stream -> T.Handle -> HT.ResponseHeaders -> IO ()
sendHeader :: Context -> Stream -> Handle -> ResponseHeaders -> IO ()
sendHeader Context
ctx Stream
strm Handle
th ResponseHeaders
hdrs = do
    -- fixme: fixHeaders
    (TokenHeaderList
ths, ValueTable
_) <- ResponseHeaders -> IO (TokenHeaderList, ValueTable)
toHeaderTable ResponseHeaders
hdrs
    (ByteString
hdr, ByteString
"") <- Context -> QEncoder
qpackEncode Context
ctx TokenHeaderList
ths
    let frames :: [H3Frame]
frames = [H3FrameType -> ByteString -> H3Frame
H3Frame H3FrameType
H3FrameHeaders ByteString
hdr]
        frames' :: [H3Frame]
frames' = Hooks -> [H3Frame] -> [H3Frame]
onHeadersFrameCreated (Context -> Hooks
getHooks Context
ctx) [H3Frame]
frames
        bss :: [ByteString]
bss = [H3Frame] -> [ByteString]
encodeH3Frames [H3Frame]
frames'
    Stream -> [ByteString] -> IO ()
sendStreamMany Stream
strm [ByteString]
bss
    Handle -> IO ()
T.tickle Handle
th

sendBody :: Context -> Stream -> T.Handle -> OutObj -> IO ()
sendBody :: Context -> Stream -> Handle -> OutObj -> IO ()
sendBody Context
ctx Stream
strm Handle
th OutObj
outobj = case OutObj -> OutBody
outObjBody OutObj
outobj of
    OutBody
OutBodyNone -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    OutBodyFile (FileSpec FilePath
path FileOffset
fileoff FileOffset
bytecount) -> do
        (PositionRead
pread, Sentinel
sentinel') <- Context -> PositionReadMaker
pReadMaker Context
ctx FilePath
path
        IO ()
refresh <- case Sentinel
sentinel' of
                     Closer IO ()
closer       -> Context -> IO () -> IO (IO ())
timeoutClose Context
ctx IO ()
closer
                     Refresher IO ()
refresher -> forall (m :: * -> *) a. Monad m => a -> m a
return IO ()
refresher
        let next :: DynaNext
next = PositionRead -> FileOffset -> FileOffset -> IO () -> DynaNext
fillFileBodyGetNext PositionRead
pread FileOffset
fileoff FileOffset
bytecount IO ()
refresh
        Context -> Stream -> Handle -> DynaNext -> TrailersMaker -> IO ()
sendNext Context
ctx Stream
strm Handle
th DynaNext
next TrailersMaker
tlrmkr
    OutBodyBuilder Builder
builder -> do
        let next :: DynaNext
next = Builder -> DynaNext
fillBuilderBodyGetNext Builder
builder
        Context -> Stream -> Handle -> DynaNext -> TrailersMaker -> IO ()
sendNext Context
ctx Stream
strm Handle
th DynaNext
next TrailersMaker
tlrmkr
    OutBodyStreaming (Builder -> IO ()) -> IO () -> IO ()
strmbdy -> Context
-> Stream
-> Handle
-> ((Builder -> IO ()) -> IO () -> IO ())
-> TrailersMaker
-> IO ()
sendStreaming Context
ctx Stream
strm Handle
th (Builder -> IO ()) -> IO () -> IO ()
strmbdy TrailersMaker
tlrmkr
  where
    tlrmkr :: TrailersMaker
tlrmkr = OutObj -> TrailersMaker
outObjTrailers OutObj
outobj

sendNext :: Context -> Stream -> T.Handle -> DynaNext -> TrailersMaker -> IO ()
sendNext :: Context -> Stream -> Handle -> DynaNext -> TrailersMaker -> IO ()
sendNext Context
ctx Stream
strm Handle
th DynaNext
curr TrailersMaker
tlrmkr0 = do
    (ByteString
bs, Maybe DynaNext
mnext, TrailersMaker
tlrmkr) <- TrailersMaker
-> DynaNext -> IO (ByteString, Maybe DynaNext, TrailersMaker)
newByteStringWith TrailersMaker
tlrmkr0 DynaNext
curr
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString
bs forall a. Eq a => a -> a -> Bool
/= ByteString
"") forall a b. (a -> b) -> a -> b
$ H3Frame -> IO ByteString
encodeH3Frame (H3FrameType -> ByteString -> H3Frame
H3Frame H3FrameType
H3FrameData ByteString
bs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream -> ByteString -> IO ()
sendStream Stream
strm
    Handle -> IO ()
T.tickle Handle
th
    case Maybe DynaNext
mnext of
      Maybe DynaNext
Nothing -> do
          Trailers ResponseHeaders
trailers <- TrailersMaker
tlrmkr forall a. Maybe a
Nothing
          forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null ResponseHeaders
trailers) forall a b. (a -> b) -> a -> b
$ Context -> Stream -> Handle -> ResponseHeaders -> IO ()
sendHeader Context
ctx Stream
strm Handle
th ResponseHeaders
trailers
      Just DynaNext
next -> Context -> Stream -> Handle -> DynaNext -> TrailersMaker -> IO ()
sendNext Context
ctx Stream
strm Handle
th DynaNext
next TrailersMaker
tlrmkr

newByteStringWith :: TrailersMaker -> DynaNext -> IO (ByteString, Maybe DynaNext, TrailersMaker)
newByteStringWith :: TrailersMaker
-> DynaNext -> IO (ByteString, Maybe DynaNext, TrailersMaker)
newByteStringWith TrailersMaker
tlrmkr0 DynaNext
action = do
    ForeignPtr Word8
fp <- forall a. Int -> IO (ForeignPtr a)
BS.mallocByteString Int
2048
    Next Int
len Bool
_reqflush Maybe DynaNext
mnext1 <- forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
buf -> DynaNext
action Ptr Word8
buf Int
2048 Int
65536 -- window size
    if Int
len forall a. Eq a => a -> a -> Bool
== Int
0 then
        forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
"", forall a. Maybe a
Nothing, TrailersMaker
tlrmkr0)
      else do
        let bs :: ByteString
bs = ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fp Int
0 Int
len
        NextTrailersMaker TrailersMaker
tlrmkr1 <- TrailersMaker
tlrmkr0 forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ByteString
bs
        forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
bs, Maybe DynaNext
mnext1, TrailersMaker
tlrmkr1)

newByteStringAndSend :: Stream -> T.Handle -> TrailersMaker -> B.BufferWriter
                     -> IO (B.Next, TrailersMaker)
newByteStringAndSend :: Stream
-> Handle
-> TrailersMaker
-> BufferWriter
-> IO (Next, TrailersMaker)
newByteStringAndSend Stream
strm Handle
th TrailersMaker
tlrmkr0 BufferWriter
action = do
    ForeignPtr Word8
fp <- forall a. Int -> IO (ForeignPtr a)
BS.mallocByteString Int
2048
    (Int
len, Next
signal) <- forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fp forall a b. (a -> b) -> a -> b
$ \Ptr Word8
buf -> BufferWriter
action Ptr Word8
buf Int
2048
    if Int
len forall a. Eq a => a -> a -> Bool
== Int
0 then
        forall (m :: * -> *) a. Monad m => a -> m a
return (Next
signal, TrailersMaker
tlrmkr0)
      else do
        let bs :: ByteString
bs = ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
fp Int
0 Int
len
        NextTrailersMaker TrailersMaker
tlrmkr1 <- TrailersMaker
tlrmkr0 forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ByteString
bs
        H3Frame -> IO ByteString
encodeH3Frame (H3FrameType -> ByteString -> H3Frame
H3Frame H3FrameType
H3FrameData ByteString
bs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream -> ByteString -> IO ()
sendStream Stream
strm
        Handle -> IO ()
T.tickle Handle
th
        forall (m :: * -> *) a. Monad m => a -> m a
return (Next
signal, TrailersMaker
tlrmkr1)

sendStreaming :: Context -> Stream -> T.Handle -> ((Builder -> IO ()) -> IO () -> IO ()) -> TrailersMaker -> IO ()
sendStreaming :: Context
-> Stream
-> Handle
-> ((Builder -> IO ()) -> IO () -> IO ())
-> TrailersMaker
-> IO ()
sendStreaming Context
ctx Stream
strm Handle
th (Builder -> IO ()) -> IO () -> IO ()
strmbdy TrailersMaker
tlrmkr0 = do
    IORef TrailersMaker
ref <- forall a. a -> IO (IORef a)
newIORef TrailersMaker
tlrmkr0
    (Builder -> IO ()) -> IO () -> IO ()
strmbdy (IORef TrailersMaker -> Builder -> IO ()
write IORef TrailersMaker
ref) IO ()
flush
    TrailersMaker
tlrmkr <- forall a. IORef a -> IO a
readIORef IORef TrailersMaker
ref
    Trailers ResponseHeaders
trailers <- TrailersMaker
tlrmkr forall a. Maybe a
Nothing
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null ResponseHeaders
trailers) forall a b. (a -> b) -> a -> b
$ Context -> Stream -> Handle -> ResponseHeaders -> IO ()
sendHeader Context
ctx Stream
strm Handle
th ResponseHeaders
trailers
  where
    flush :: IO ()
flush = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    write :: IORef TrailersMaker -> Builder -> IO ()
write IORef TrailersMaker
ref Builder
builder = do
        TrailersMaker
tlrmkr1 <- forall a. IORef a -> IO a
readIORef IORef TrailersMaker
ref
        TrailersMaker
tlrmkr2 <- Stream
-> Handle
-> TrailersMaker
-> BufferWriter
-> IO (Next, TrailersMaker)
newByteStringAndSend Stream
strm Handle
th TrailersMaker
tlrmkr1 (Builder -> BufferWriter
B.runBuilder Builder
builder) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Next, TrailersMaker) -> IO TrailersMaker
loop
        forall a. IORef a -> a -> IO ()
writeIORef IORef TrailersMaker
ref TrailersMaker
tlrmkr2
      where
        loop :: (Next, TrailersMaker) -> IO TrailersMaker
loop (Next
B.Done,           TrailersMaker
tlrmkr1) = forall (m :: * -> *) a. Monad m => a -> m a
return TrailersMaker
tlrmkr1
        loop (B.More Int
_ BufferWriter
writer,  TrailersMaker
tlrmkr1) =
            Stream
-> Handle
-> TrailersMaker
-> BufferWriter
-> IO (Next, TrailersMaker)
newByteStringAndSend Stream
strm Handle
th TrailersMaker
tlrmkr1 BufferWriter
writer forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Next, TrailersMaker) -> IO TrailersMaker
loop
        loop (B.Chunk ByteString
bs BufferWriter
writer, TrailersMaker
tlrmkr1) = do
            H3Frame -> IO ByteString
encodeH3Frame (H3FrameType -> ByteString -> H3Frame
H3Frame H3FrameType
H3FrameData ByteString
bs) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream -> ByteString -> IO ()
sendStream Stream
strm
            NextTrailersMaker TrailersMaker
tlrmkr2 <- TrailersMaker
tlrmkr1 forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ByteString
bs
            Handle -> IO ()
T.tickle Handle
th
            Stream
-> Handle
-> TrailersMaker
-> BufferWriter
-> IO (Next, TrailersMaker)
newByteStringAndSend Stream
strm Handle
th TrailersMaker
tlrmkr2 BufferWriter
writer forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Next, TrailersMaker) -> IO TrailersMaker
loop