{-# 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 ()
Context
ctx Stream
strm Handle
th ResponseHeaders
hdrs = do
(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
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