{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Network.HTTP3.Context (
    Context
  , newContext
  , clearContext
  , unidirectional
  , isH3Server
  , isH3Client
  , accept
  , qpackEncode
  , qpackDecode
  , registerThread
  , timeoutClose
  , newStream
  , closeStream
  , pReadMaker
  , addThreadId
  , abort
  , getHooks
  , Hooks(..) -- re-export
  ) where

import Control.Concurrent
import qualified Data.ByteString as BS
import Data.IORef
import Network.HTTP2.Internal (PositionReadMaker)
import Network.QUIC
import Network.QUIC.Internal (isServer, isClient, connDebugLog)
import System.Mem.Weak
import qualified System.TimeManager as T
import qualified UnliftIO.Exception as E

import Network.HTTP3.Config
import Network.HTTP3.Stream
import Network.QPACK
import Network.QPACK.Internal

data Context = Context {
    Context -> Connection
ctxConnection :: Connection
  , Context -> QEncoder
ctxQEncoder   :: QEncoder
  , Context -> QDecoder
ctxQDecoder   :: QDecoder
  , Context -> H3StreamType -> InstructionHandler
ctxUniSwitch  :: H3StreamType -> InstructionHandler
  , Context -> PositionReadMaker
ctxPReadMaker :: PositionReadMaker
  , Context -> Manager
ctxManager    :: T.Manager
  , Context -> Hooks
ctxHooks      :: Hooks
  , Context -> IORef [Weak ThreadId]
ctxThreads    :: IORef [Weak ThreadId]
  }

newContext :: Connection -> Config -> InstructionHandler -> IO Context
newContext :: Connection -> Config -> InstructionHandler -> IO Context
newContext Connection
conn Config
conf InstructionHandler
ctl = do
    (QEncoder
enc, InstructionHandler
handleDI) <- QEncoderConfig -> IO (QEncoder, InstructionHandler)
newQEncoder QEncoderConfig
defaultQEncoderConfig
    (QDecoder
dec, InstructionHandler
handleEI) <- QDecoderConfig -> IO (QDecoder, InstructionHandler)
newQDecoder QDecoderConfig
defaultQDecoderConfig
    let handleDI' :: InstructionHandler
handleDI' Int -> IO EncodedDecoderInstruction
recv = InstructionHandler
handleDI Int -> IO EncodedDecoderInstruction
recv forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (SomeException -> m a) -> m a
`E.catchAny` forall {p}. ApplicationProtocolError -> p -> IO ()
abortWith ApplicationProtocolError
QpackDecoderStreamError
        handleEI' :: InstructionHandler
handleEI' Int -> IO EncodedDecoderInstruction
recv = InstructionHandler
handleEI Int -> IO EncodedDecoderInstruction
recv forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (SomeException -> m a) -> m a
`E.catchAny` forall {p}. ApplicationProtocolError -> p -> IO ()
abortWith ApplicationProtocolError
QpackEncoderStreamError
        sw :: H3StreamType -> InstructionHandler
sw = Connection
-> InstructionHandler
-> InstructionHandler
-> InstructionHandler
-> H3StreamType
-> InstructionHandler
switch Connection
conn InstructionHandler
ctl InstructionHandler
handleEI' InstructionHandler
handleDI'
        preadM :: PositionReadMaker
preadM = Config -> PositionReadMaker
confPositionReadMaker Config
conf
        timmgr :: Manager
timmgr = Config -> Manager
confTimeoutManager Config
conf
        hooks :: Hooks
hooks  = Config -> Hooks
confHooks Config
conf
    Connection
-> QEncoder
-> QDecoder
-> (H3StreamType -> InstructionHandler)
-> PositionReadMaker
-> Manager
-> Hooks
-> IORef [Weak ThreadId]
-> Context
Context Connection
conn QEncoder
enc QDecoder
dec H3StreamType -> InstructionHandler
sw PositionReadMaker
preadM Manager
timmgr Hooks
hooks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef []
  where
    abortWith :: ApplicationProtocolError -> p -> IO ()
abortWith ApplicationProtocolError
aerr p
_se = Connection -> ApplicationProtocolError -> ReasonPhrase -> IO ()
abortConnection Connection
conn ApplicationProtocolError
aerr ReasonPhrase
""

clearContext :: Context -> IO ()
clearContext :: Context -> IO ()
clearContext Context
ctx = Context -> IO ()
clearThreads Context
ctx

switch :: Connection -> InstructionHandler -> InstructionHandler -> InstructionHandler -> H3StreamType -> InstructionHandler
switch :: Connection
-> InstructionHandler
-> InstructionHandler
-> InstructionHandler
-> H3StreamType
-> InstructionHandler
switch Connection
conn InstructionHandler
ctl InstructionHandler
handleEI InstructionHandler
handleDI H3StreamType
styp
  | H3StreamType
styp forall a. Eq a => a -> a -> Bool
== H3StreamType
H3ControlStreams   = InstructionHandler
ctl
  | H3StreamType
styp forall a. Eq a => a -> a -> Bool
== H3StreamType
QPACKEncoderStream = InstructionHandler
handleEI
  | H3StreamType
styp forall a. Eq a => a -> a -> Bool
== H3StreamType
QPACKDecoderStream = InstructionHandler
handleDI
  | Bool
otherwise                  = \Int -> IO EncodedDecoderInstruction
_ -> Connection -> DebugLogger
connDebugLog Connection
conn Builder
"switch unknown stream type"

isH3Server :: Context -> Bool
isH3Server :: Context -> Bool
isH3Server Context{Manager
IORef [Weak ThreadId]
Connection
Hooks
PositionReadMaker
QEncoder
QDecoder
H3StreamType -> InstructionHandler
ctxThreads :: IORef [Weak ThreadId]
ctxHooks :: Hooks
ctxManager :: Manager
ctxPReadMaker :: PositionReadMaker
ctxUniSwitch :: H3StreamType -> InstructionHandler
ctxQDecoder :: QDecoder
ctxQEncoder :: QEncoder
ctxConnection :: Connection
ctxThreads :: Context -> IORef [Weak ThreadId]
ctxHooks :: Context -> Hooks
ctxManager :: Context -> Manager
ctxPReadMaker :: Context -> PositionReadMaker
ctxUniSwitch :: Context -> H3StreamType -> InstructionHandler
ctxQDecoder :: Context -> QDecoder
ctxQEncoder :: Context -> QEncoder
ctxConnection :: Context -> Connection
..} = forall a. Connector a => a -> Bool
isServer Connection
ctxConnection

isH3Client :: Context -> Bool
isH3Client :: Context -> Bool
isH3Client Context{Manager
IORef [Weak ThreadId]
Connection
Hooks
PositionReadMaker
QEncoder
QDecoder
H3StreamType -> InstructionHandler
ctxThreads :: IORef [Weak ThreadId]
ctxHooks :: Hooks
ctxManager :: Manager
ctxPReadMaker :: PositionReadMaker
ctxUniSwitch :: H3StreamType -> InstructionHandler
ctxQDecoder :: QDecoder
ctxQEncoder :: QEncoder
ctxConnection :: Connection
ctxThreads :: Context -> IORef [Weak ThreadId]
ctxHooks :: Context -> Hooks
ctxManager :: Context -> Manager
ctxPReadMaker :: Context -> PositionReadMaker
ctxUniSwitch :: Context -> H3StreamType -> InstructionHandler
ctxQDecoder :: Context -> QDecoder
ctxQEncoder :: Context -> QEncoder
ctxConnection :: Context -> Connection
..} = forall a. Connector a => a -> Bool
isClient Connection
ctxConnection

accept :: Context -> IO Stream
accept :: Context -> IO Stream
accept Context{Manager
IORef [Weak ThreadId]
Connection
Hooks
PositionReadMaker
QEncoder
QDecoder
H3StreamType -> InstructionHandler
ctxThreads :: IORef [Weak ThreadId]
ctxHooks :: Hooks
ctxManager :: Manager
ctxPReadMaker :: PositionReadMaker
ctxUniSwitch :: H3StreamType -> InstructionHandler
ctxQDecoder :: QDecoder
ctxQEncoder :: QEncoder
ctxConnection :: Connection
ctxThreads :: Context -> IORef [Weak ThreadId]
ctxHooks :: Context -> Hooks
ctxManager :: Context -> Manager
ctxPReadMaker :: Context -> PositionReadMaker
ctxUniSwitch :: Context -> H3StreamType -> InstructionHandler
ctxQDecoder :: Context -> QDecoder
ctxQEncoder :: Context -> QEncoder
ctxConnection :: Context -> Connection
..} = Connection -> IO Stream
acceptStream Connection
ctxConnection

qpackEncode :: Context -> QEncoder
qpackEncode :: Context -> QEncoder
qpackEncode Context{Manager
IORef [Weak ThreadId]
Connection
Hooks
PositionReadMaker
QEncoder
QDecoder
H3StreamType -> InstructionHandler
ctxThreads :: IORef [Weak ThreadId]
ctxHooks :: Hooks
ctxManager :: Manager
ctxPReadMaker :: PositionReadMaker
ctxUniSwitch :: H3StreamType -> InstructionHandler
ctxQDecoder :: QDecoder
ctxQEncoder :: QEncoder
ctxConnection :: Connection
ctxThreads :: Context -> IORef [Weak ThreadId]
ctxHooks :: Context -> Hooks
ctxManager :: Context -> Manager
ctxPReadMaker :: Context -> PositionReadMaker
ctxUniSwitch :: Context -> H3StreamType -> InstructionHandler
ctxQDecoder :: Context -> QDecoder
ctxQEncoder :: Context -> QEncoder
ctxConnection :: Context -> Connection
..} = QEncoder
ctxQEncoder

qpackDecode :: Context -> QDecoder
qpackDecode :: Context -> QDecoder
qpackDecode Context{Manager
IORef [Weak ThreadId]
Connection
Hooks
PositionReadMaker
QEncoder
QDecoder
H3StreamType -> InstructionHandler
ctxThreads :: IORef [Weak ThreadId]
ctxHooks :: Hooks
ctxManager :: Manager
ctxPReadMaker :: PositionReadMaker
ctxUniSwitch :: H3StreamType -> InstructionHandler
ctxQDecoder :: QDecoder
ctxQEncoder :: QEncoder
ctxConnection :: Connection
ctxThreads :: Context -> IORef [Weak ThreadId]
ctxHooks :: Context -> Hooks
ctxManager :: Context -> Manager
ctxPReadMaker :: Context -> PositionReadMaker
ctxUniSwitch :: Context -> H3StreamType -> InstructionHandler
ctxQDecoder :: Context -> QDecoder
ctxQEncoder :: Context -> QEncoder
ctxConnection :: Context -> Connection
..} = QDecoder
ctxQDecoder

unidirectional :: Context -> Stream -> IO ()
unidirectional :: Context -> Stream -> IO ()
unidirectional Context{Manager
IORef [Weak ThreadId]
Connection
Hooks
PositionReadMaker
QEncoder
QDecoder
H3StreamType -> InstructionHandler
ctxThreads :: IORef [Weak ThreadId]
ctxHooks :: Hooks
ctxManager :: Manager
ctxPReadMaker :: PositionReadMaker
ctxUniSwitch :: H3StreamType -> InstructionHandler
ctxQDecoder :: QDecoder
ctxQEncoder :: QEncoder
ctxConnection :: Connection
ctxThreads :: Context -> IORef [Weak ThreadId]
ctxHooks :: Context -> Hooks
ctxManager :: Context -> Manager
ctxPReadMaker :: Context -> PositionReadMaker
ctxUniSwitch :: Context -> H3StreamType -> InstructionHandler
ctxQDecoder :: Context -> QDecoder
ctxQEncoder :: Context -> QEncoder
ctxConnection :: Context -> Connection
..} Stream
strm = do
    Word8
w8:[Word8]
_ <- EncodedDecoderInstruction -> [Word8]
BS.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stream -> Int -> IO EncodedDecoderInstruction
recvStream Stream
strm Int
1 -- fixme: variable length
    let typ :: H3StreamType
typ = Int64 -> H3StreamType
toH3StreamType forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w8
    H3StreamType -> InstructionHandler
ctxUniSwitch H3StreamType
typ (Stream -> Int -> IO EncodedDecoderInstruction
recvStream Stream
strm)

registerThread :: Context -> IO T.Handle
registerThread :: Context -> IO Handle
registerThread Context{Manager
IORef [Weak ThreadId]
Connection
Hooks
PositionReadMaker
QEncoder
QDecoder
H3StreamType -> InstructionHandler
ctxThreads :: IORef [Weak ThreadId]
ctxHooks :: Hooks
ctxManager :: Manager
ctxPReadMaker :: PositionReadMaker
ctxUniSwitch :: H3StreamType -> InstructionHandler
ctxQDecoder :: QDecoder
ctxQEncoder :: QEncoder
ctxConnection :: Connection
ctxThreads :: Context -> IORef [Weak ThreadId]
ctxHooks :: Context -> Hooks
ctxManager :: Context -> Manager
ctxPReadMaker :: Context -> PositionReadMaker
ctxUniSwitch :: Context -> H3StreamType -> InstructionHandler
ctxQDecoder :: Context -> QDecoder
ctxQEncoder :: Context -> QEncoder
ctxConnection :: Context -> Connection
..} = Manager -> IO () -> IO Handle
T.registerKillThread Manager
ctxManager (forall (m :: * -> *) a. Monad m => a -> m a
return ())

timeoutClose :: Context -> IO () -> IO (IO ())
timeoutClose :: Context -> IO () -> IO (IO ())
timeoutClose Context{Manager
IORef [Weak ThreadId]
Connection
Hooks
PositionReadMaker
QEncoder
QDecoder
H3StreamType -> InstructionHandler
ctxThreads :: IORef [Weak ThreadId]
ctxHooks :: Hooks
ctxManager :: Manager
ctxPReadMaker :: PositionReadMaker
ctxUniSwitch :: H3StreamType -> InstructionHandler
ctxQDecoder :: QDecoder
ctxQEncoder :: QEncoder
ctxConnection :: Connection
ctxThreads :: Context -> IORef [Weak ThreadId]
ctxHooks :: Context -> Hooks
ctxManager :: Context -> Manager
ctxPReadMaker :: Context -> PositionReadMaker
ctxUniSwitch :: Context -> H3StreamType -> InstructionHandler
ctxQDecoder :: Context -> QDecoder
ctxQEncoder :: Context -> QEncoder
ctxConnection :: Context -> Connection
..} IO ()
closer = do
    Handle
th <- Manager -> IO () -> IO Handle
T.register Manager
ctxManager IO ()
closer
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
T.tickle Handle
th

newStream :: Context -> IO Stream
newStream :: Context -> IO Stream
newStream Context{Manager
IORef [Weak ThreadId]
Connection
Hooks
PositionReadMaker
QEncoder
QDecoder
H3StreamType -> InstructionHandler
ctxThreads :: IORef [Weak ThreadId]
ctxHooks :: Hooks
ctxManager :: Manager
ctxPReadMaker :: PositionReadMaker
ctxUniSwitch :: H3StreamType -> InstructionHandler
ctxQDecoder :: QDecoder
ctxQEncoder :: QEncoder
ctxConnection :: Connection
ctxThreads :: Context -> IORef [Weak ThreadId]
ctxHooks :: Context -> Hooks
ctxManager :: Context -> Manager
ctxPReadMaker :: Context -> PositionReadMaker
ctxUniSwitch :: Context -> H3StreamType -> InstructionHandler
ctxQDecoder :: Context -> QDecoder
ctxQEncoder :: Context -> QEncoder
ctxConnection :: Context -> Connection
..} = Connection -> IO Stream
stream Connection
ctxConnection

pReadMaker :: Context -> PositionReadMaker
pReadMaker :: Context -> PositionReadMaker
pReadMaker = Context -> PositionReadMaker
ctxPReadMaker

addThreadId :: Context -> ThreadId -> IO ()
addThreadId :: Context -> ThreadId -> IO ()
addThreadId Context{Manager
IORef [Weak ThreadId]
Connection
Hooks
PositionReadMaker
QEncoder
QDecoder
H3StreamType -> InstructionHandler
ctxThreads :: IORef [Weak ThreadId]
ctxHooks :: Hooks
ctxManager :: Manager
ctxPReadMaker :: PositionReadMaker
ctxUniSwitch :: H3StreamType -> InstructionHandler
ctxQDecoder :: QDecoder
ctxQEncoder :: QEncoder
ctxConnection :: Connection
ctxThreads :: Context -> IORef [Weak ThreadId]
ctxHooks :: Context -> Hooks
ctxManager :: Context -> Manager
ctxPReadMaker :: Context -> PositionReadMaker
ctxUniSwitch :: Context -> H3StreamType -> InstructionHandler
ctxQDecoder :: Context -> QDecoder
ctxQEncoder :: Context -> QEncoder
ctxConnection :: Context -> Connection
..} ThreadId
tid = do
    Weak ThreadId
wtid <- ThreadId -> IO (Weak ThreadId)
mkWeakThreadId ThreadId
tid
    forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef [Weak ThreadId]
ctxThreads forall a b. (a -> b) -> a -> b
$ \[Weak ThreadId]
ts -> (Weak ThreadId
wtidforall a. a -> [a] -> [a]
:[Weak ThreadId]
ts, ())

clearThreads :: Context -> IO ()
clearThreads :: Context -> IO ()
clearThreads Context{Manager
IORef [Weak ThreadId]
Connection
Hooks
PositionReadMaker
QEncoder
QDecoder
H3StreamType -> InstructionHandler
ctxThreads :: IORef [Weak ThreadId]
ctxHooks :: Hooks
ctxManager :: Manager
ctxPReadMaker :: PositionReadMaker
ctxUniSwitch :: H3StreamType -> InstructionHandler
ctxQDecoder :: QDecoder
ctxQEncoder :: QEncoder
ctxConnection :: Connection
ctxThreads :: Context -> IORef [Weak ThreadId]
ctxHooks :: Context -> Hooks
ctxManager :: Context -> Manager
ctxPReadMaker :: Context -> PositionReadMaker
ctxUniSwitch :: Context -> H3StreamType -> InstructionHandler
ctxQDecoder :: Context -> QDecoder
ctxQEncoder :: Context -> QEncoder
ctxConnection :: Context -> Connection
..} = do
    [Weak ThreadId]
wtids <- forall a. IORef a -> IO a
readIORef IORef [Weak ThreadId]
ctxThreads
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Weak ThreadId -> IO ()
kill [Weak ThreadId]
wtids
    forall a. IORef a -> a -> IO ()
writeIORef IORef [Weak ThreadId]
ctxThreads []
  where
    kill :: Weak ThreadId -> IO ()
kill Weak ThreadId
wtid = do
        Maybe ThreadId
mtid <- forall v. Weak v -> IO (Maybe v)
deRefWeak Weak ThreadId
wtid
        case Maybe ThreadId
mtid of
          Maybe ThreadId
Nothing  -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just ThreadId
tid -> ThreadId -> IO ()
killThread ThreadId
tid

abort :: Context -> ApplicationProtocolError -> IO ()
abort :: Context -> ApplicationProtocolError -> IO ()
abort Context
ctx ApplicationProtocolError
aerr = Connection -> ApplicationProtocolError -> ReasonPhrase -> IO ()
abortConnection (Context -> Connection
ctxConnection Context
ctx) ApplicationProtocolError
aerr ReasonPhrase
""

getHooks :: Context -> Hooks
getHooks :: Context -> Hooks
getHooks = Context -> Hooks
ctxHooks