{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Network.HTTP3.Recv (
Source
, newSource
, readSource
, recvHeader
, recvBody
) where
import qualified Data.ByteString as BS
import Data.IORef
import Network.HPACK (HeaderTable)
import Network.QUIC
import Imports
import Network.HTTP3.Context
import Network.HTTP3.Error
import Network.HTTP3.Frame
data Source = Source {
Source -> IO ByteString
sourceRead :: IO ByteString
, Source -> IORef (Maybe ByteString)
sourcePending :: IORef (Maybe ByteString)
}
newSource :: Stream -> IO Source
newSource :: Stream -> IO Source
newSource Stream
strm = IO ByteString -> IORef (Maybe ByteString) -> Source
Source (Stream -> Int -> IO ByteString
recvStream Stream
strm Int
1024) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
readSource :: Source -> IO ByteString
readSource :: Source -> IO ByteString
readSource Source{IO ByteString
IORef (Maybe ByteString)
sourcePending :: IORef (Maybe ByteString)
sourceRead :: IO ByteString
sourcePending :: Source -> IORef (Maybe ByteString)
sourceRead :: Source -> IO ByteString
..} = do
Maybe ByteString
mx <- forall a. IORef a -> IO a
readIORef IORef (Maybe ByteString)
sourcePending
case Maybe ByteString
mx of
Maybe ByteString
Nothing -> IO ByteString
sourceRead
Just ByteString
x -> do
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe ByteString)
sourcePending forall a. Maybe a
Nothing
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
x
pushbackSource :: Source -> ByteString -> IO ()
pushbackSource :: Source -> ByteString -> IO ()
pushbackSource Source
_ ByteString
"" = forall (m :: * -> *) a. Monad m => a -> m a
return ()
pushbackSource Source{IO ByteString
IORef (Maybe ByteString)
sourcePending :: IORef (Maybe ByteString)
sourceRead :: IO ByteString
sourcePending :: Source -> IORef (Maybe ByteString)
sourceRead :: Source -> IO ByteString
..} ByteString
bs = forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe ByteString)
sourcePending forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ByteString
bs
recvHeader :: Context -> Source -> IO (Maybe HeaderTable)
Context
ctx Source
src = IFrame -> IO (Maybe HeaderTable)
loop IFrame
IInit
where
loop :: IFrame -> IO (Maybe HeaderTable)
loop IFrame
st = do
ByteString
bs <- Source -> IO ByteString
readSource Source
src
if ByteString
bs forall a. Eq a => a -> a -> Bool
== ByteString
"" then
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else
case IFrame -> ByteString -> IFrame
parseH3Frame IFrame
st ByteString
bs of
IDone H3FrameType
typ ByteString
payload ByteString
leftover
| H3FrameType
typ forall a. Eq a => a -> a -> Bool
== H3FrameType
H3FrameHeaders -> do
Source -> ByteString -> IO ()
pushbackSource Source
src ByteString
leftover
forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context -> QDecoder
qpackDecode Context
ctx ByteString
payload
| H3FrameType
typ forall a. Eq a => a -> a -> Bool
== H3FrameType
H3FrameData -> do
Context -> ApplicationProtocolError -> IO ()
abort Context
ctx ApplicationProtocolError
H3FrameUnexpected
IFrame -> IO (Maybe HeaderTable)
loop IFrame
IInit
| H3FrameType -> Bool
permittedInRequestStream H3FrameType
typ -> do
Source -> ByteString -> IO ()
pushbackSource Source
src ByteString
leftover
IFrame -> IO (Maybe HeaderTable)
loop IFrame
IInit
| Bool
otherwise -> do
Context -> ApplicationProtocolError -> IO ()
abort Context
ctx ApplicationProtocolError
H3FrameUnexpected
IFrame -> IO (Maybe HeaderTable)
loop IFrame
IInit
IFrame
st' -> IFrame -> IO (Maybe HeaderTable)
loop IFrame
st'
recvBody :: Context -> Source -> IORef IFrame -> IORef (Maybe HeaderTable) -> IO ByteString
recvBody :: Context
-> Source
-> IORef IFrame
-> IORef (Maybe HeaderTable)
-> IO ByteString
recvBody Context
ctx Source
src IORef IFrame
refI IORef (Maybe HeaderTable)
refH = do
IFrame
st <- forall a. IORef a -> IO a
readIORef IORef IFrame
refI
IFrame -> IO ByteString
loop IFrame
st
where
loop :: IFrame -> IO ByteString
loop IFrame
st = do
ByteString
bs <- Source -> IO ByteString
readSource Source
src
if ByteString
bs forall a. Eq a => a -> a -> Bool
== ByteString
"" then
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
""
else
case IFrame -> ByteString -> IFrame
parseH3Frame IFrame
st ByteString
bs of
IPay H3FrameType
H3FrameData Int
siz Int
received [ByteString]
bss -> do
let st' :: IFrame
st' = H3FrameType -> Int -> Int -> [ByteString] -> IFrame
IPay H3FrameType
H3FrameData Int
siz Int
received []
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
bss then
IFrame -> IO ByteString
loop IFrame
st'
else do
forall a. IORef a -> a -> IO ()
writeIORef IORef IFrame
refI IFrame
st'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BS.concat forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [ByteString]
bss
IDone H3FrameType
typ ByteString
payload ByteString
leftover
| H3FrameType
typ forall a. Eq a => a -> a -> Bool
== H3FrameType
H3FrameHeaders -> do
forall a. IORef a -> a -> IO ()
writeIORef IORef IFrame
refI IFrame
IInit
HeaderTable
hdr <- Context -> QDecoder
qpackDecode Context
ctx ByteString
payload
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe HeaderTable)
refH forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just HeaderTable
hdr
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
""
| H3FrameType
typ forall a. Eq a => a -> a -> Bool
== H3FrameType
H3FrameData -> do
forall a. IORef a -> a -> IO ()
writeIORef IORef IFrame
refI IFrame
IInit
Source -> ByteString -> IO ()
pushbackSource Source
src ByteString
leftover
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
payload
| H3FrameType -> Bool
permittedInRequestStream H3FrameType
typ -> do
Source -> ByteString -> IO ()
pushbackSource Source
src ByteString
leftover
IFrame -> IO ByteString
loop IFrame
IInit
| Bool
otherwise -> do
Context -> ApplicationProtocolError -> IO ()
abort Context
ctx ApplicationProtocolError
H3FrameUnexpected
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
payload
IFrame
st' -> IFrame -> IO ByteString
loop IFrame
st'