{-# 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)
recvHeader :: Context -> Source -> IO (Maybe HeaderTable)
recvHeader 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 -- dummy
                  | 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 -- dummy
              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
                      -- pushbackSource src leftover -- fixme
                      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 -- dummy
              IFrame
st' -> IFrame -> IO ByteString
loop IFrame
st'