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

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

import Control.Concurrent
import qualified Control.Exception as E
import qualified Data.ByteString as BS
import Data.IORef
import Network.HTTP.Semantics.Client
import Network.QUIC
import Network.QUIC.Internal (connDebugLog, isClient, isServer)
import Network.Socket (SockAddr)
import System.Mem.Weak
import qualified System.TimeManager as T

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 -> SockAddr
ctxMySockAddr :: SockAddr
    , Context -> SockAddr
ctxPeerSockAddr :: SockAddr
    , 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
    ConnectionInfo
info <- Connection -> IO ConnectionInfo
getConnectionInfo Connection
conn
    let handleDI' :: InstructionHandler
handleDI' Int -> IO EncodedDecoderInstruction
recv = InstructionHandler
handleDI Int -> IO EncodedDecoderInstruction
recv IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` ApplicationProtocolError -> SomeException -> IO ()
abortWith ApplicationProtocolError
QpackDecoderStreamError
        handleEI' :: InstructionHandler
handleEI' Int -> IO EncodedDecoderInstruction
recv = InstructionHandler
handleEI Int -> IO EncodedDecoderInstruction
recv IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` ApplicationProtocolError -> SomeException -> 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
        mysa :: SockAddr
mysa = ConnectionInfo -> SockAddr
localSockAddr ConnectionInfo
info
        peersa :: SockAddr
peersa = ConnectionInfo -> SockAddr
remoteSockAddr ConnectionInfo
info
    Connection
-> QEncoder
-> QDecoder
-> (H3StreamType -> InstructionHandler)
-> PositionReadMaker
-> Manager
-> Hooks
-> SockAddr
-> SockAddr
-> IORef [Weak ThreadId]
-> Context
Context Connection
conn QEncoder
enc QDecoder
dec H3StreamType -> InstructionHandler
sw PositionReadMaker
preadM Manager
timmgr Hooks
hooks SockAddr
mysa SockAddr
peersa (IORef [Weak ThreadId] -> Context)
-> IO (IORef [Weak ThreadId]) -> IO Context
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Weak ThreadId] -> IO (IORef [Weak ThreadId])
forall a. a -> IO (IORef a)
newIORef []
  where
    abortWith :: ApplicationProtocolError -> SomeException -> IO ()
abortWith ApplicationProtocolError
aerr SomeException
se
        | Just AsyncException
E.ThreadKilled <- SomeException -> Maybe AsyncException
forall e. Exception e => SomeException -> Maybe e
E.fromException SomeException
se = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        | Bool
otherwise = 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 H3StreamType -> H3StreamType -> Bool
forall a. Eq a => a -> a -> Bool
== H3StreamType
H3ControlStreams = InstructionHandler
ctl
    | H3StreamType
styp H3StreamType -> H3StreamType -> Bool
forall a. Eq a => a -> a -> Bool
== H3StreamType
QPACKEncoderStream = InstructionHandler
handleEI
    | H3StreamType
styp H3StreamType -> H3StreamType -> Bool
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]
SockAddr
Connection
Hooks
PositionReadMaker
QEncoder
QDecoder
H3StreamType -> InstructionHandler
ctxConnection :: Context -> Connection
ctxQEncoder :: Context -> QEncoder
ctxQDecoder :: Context -> QDecoder
ctxUniSwitch :: Context -> H3StreamType -> InstructionHandler
ctxPReadMaker :: Context -> PositionReadMaker
ctxManager :: Context -> Manager
ctxHooks :: Context -> Hooks
ctxMySockAddr :: Context -> SockAddr
ctxPeerSockAddr :: Context -> SockAddr
ctxThreads :: Context -> IORef [Weak ThreadId]
ctxConnection :: Connection
ctxQEncoder :: QEncoder
ctxQDecoder :: QDecoder
ctxUniSwitch :: H3StreamType -> InstructionHandler
ctxPReadMaker :: PositionReadMaker
ctxManager :: Manager
ctxHooks :: Hooks
ctxMySockAddr :: SockAddr
ctxPeerSockAddr :: SockAddr
ctxThreads :: IORef [Weak ThreadId]
..} = Connection -> Bool
forall a. Connector a => a -> Bool
isServer Connection
ctxConnection

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

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

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

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

unidirectional :: Context -> Stream -> IO ()
unidirectional :: Context -> Stream -> IO ()
unidirectional Context{Manager
IORef [Weak ThreadId]
SockAddr
Connection
Hooks
PositionReadMaker
QEncoder
QDecoder
H3StreamType -> InstructionHandler
ctxConnection :: Context -> Connection
ctxQEncoder :: Context -> QEncoder
ctxQDecoder :: Context -> QDecoder
ctxUniSwitch :: Context -> H3StreamType -> InstructionHandler
ctxPReadMaker :: Context -> PositionReadMaker
ctxManager :: Context -> Manager
ctxHooks :: Context -> Hooks
ctxMySockAddr :: Context -> SockAddr
ctxPeerSockAddr :: Context -> SockAddr
ctxThreads :: Context -> IORef [Weak ThreadId]
ctxConnection :: Connection
ctxQEncoder :: QEncoder
ctxQDecoder :: QDecoder
ctxUniSwitch :: H3StreamType -> InstructionHandler
ctxPReadMaker :: PositionReadMaker
ctxManager :: Manager
ctxHooks :: Hooks
ctxMySockAddr :: SockAddr
ctxPeerSockAddr :: SockAddr
ctxThreads :: IORef [Weak ThreadId]
..} Stream
strm = do
    Word8
w8 : [Word8]
_ <- EncodedDecoderInstruction -> [Word8]
BS.unpack (EncodedDecoderInstruction -> [Word8])
-> IO EncodedDecoderInstruction -> IO [Word8]
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 (Int64 -> H3StreamType) -> Int64 -> H3StreamType
forall a b. (a -> b) -> a -> b
$ Word8 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w8
    H3StreamType -> InstructionHandler
ctxUniSwitch H3StreamType
typ (Stream -> Int -> IO EncodedDecoderInstruction
recvStream Stream
strm)

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

newStream :: Context -> IO Stream
newStream :: Context -> IO Stream
newStream Context{Manager
IORef [Weak ThreadId]
SockAddr
Connection
Hooks
PositionReadMaker
QEncoder
QDecoder
H3StreamType -> InstructionHandler
ctxConnection :: Context -> Connection
ctxQEncoder :: Context -> QEncoder
ctxQDecoder :: Context -> QDecoder
ctxUniSwitch :: Context -> H3StreamType -> InstructionHandler
ctxPReadMaker :: Context -> PositionReadMaker
ctxManager :: Context -> Manager
ctxHooks :: Context -> Hooks
ctxMySockAddr :: Context -> SockAddr
ctxPeerSockAddr :: Context -> SockAddr
ctxThreads :: Context -> IORef [Weak ThreadId]
ctxConnection :: Connection
ctxQEncoder :: QEncoder
ctxQDecoder :: QDecoder
ctxUniSwitch :: H3StreamType -> InstructionHandler
ctxPReadMaker :: PositionReadMaker
ctxManager :: Manager
ctxHooks :: Hooks
ctxMySockAddr :: SockAddr
ctxPeerSockAddr :: SockAddr
ctxThreads :: IORef [Weak ThreadId]
..} = 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]
SockAddr
Connection
Hooks
PositionReadMaker
QEncoder
QDecoder
H3StreamType -> InstructionHandler
ctxConnection :: Context -> Connection
ctxQEncoder :: Context -> QEncoder
ctxQDecoder :: Context -> QDecoder
ctxUniSwitch :: Context -> H3StreamType -> InstructionHandler
ctxPReadMaker :: Context -> PositionReadMaker
ctxManager :: Context -> Manager
ctxHooks :: Context -> Hooks
ctxMySockAddr :: Context -> SockAddr
ctxPeerSockAddr :: Context -> SockAddr
ctxThreads :: Context -> IORef [Weak ThreadId]
ctxConnection :: Connection
ctxQEncoder :: QEncoder
ctxQDecoder :: QDecoder
ctxUniSwitch :: H3StreamType -> InstructionHandler
ctxPReadMaker :: PositionReadMaker
ctxManager :: Manager
ctxHooks :: Hooks
ctxMySockAddr :: SockAddr
ctxPeerSockAddr :: SockAddr
ctxThreads :: IORef [Weak ThreadId]
..} ThreadId
tid = do
    Weak ThreadId
wtid <- ThreadId -> IO (Weak ThreadId)
mkWeakThreadId ThreadId
tid
    IORef [Weak ThreadId]
-> ([Weak ThreadId] -> ([Weak ThreadId], ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef [Weak ThreadId]
ctxThreads (([Weak ThreadId] -> ([Weak ThreadId], ())) -> IO ())
-> ([Weak ThreadId] -> ([Weak ThreadId], ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[Weak ThreadId]
ts -> (Weak ThreadId
wtid Weak ThreadId -> [Weak ThreadId] -> [Weak ThreadId]
forall a. a -> [a] -> [a]
: [Weak ThreadId]
ts, ())

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

getMySockAddr :: Context -> SockAddr
getMySockAddr :: Context -> SockAddr
getMySockAddr = Context -> SockAddr
ctxMySockAddr

getPeerSockAddr :: Context -> SockAddr
getPeerSockAddr :: Context -> SockAddr
getPeerSockAddr = Context -> SockAddr
ctxMySockAddr