{-# 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(..)
) 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
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