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

module Network.HTTP3.Context (
    Context,
    withContext,
    unidirectional,
    isH3Server,
    isH3Client,
    accept,
    qpackEncode,
    qpackDecode,
    withHandle,
    newStream,
    closeStream,
    pReadMaker,
    abort,
    getHooks,
    Hooks (..), -- re-export
    getMySockAddr,
    getPeerSockAddr,
    forkManaged,
    forkManagedTimeout,
    forkManagedTimeoutFinally,
    isAsyncException,
) where

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 qualified System.ThreadManager as T

import Network.HTTP3.Config
import Network.HTTP3.Control
import Network.HTTP3.Frame
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 -> ThreadManager
ctxThreadManager :: T.ThreadManager
    , Context -> Hooks
ctxHooks :: Hooks
    , Context -> SockAddr
ctxMySockAddr :: SockAddr
    , Context -> SockAddr
ctxPeerSockAddr :: SockAddr
    }

withContext :: Connection -> Config -> (Context -> IO a) -> IO a
withContext :: forall a. Connection -> Config -> (Context -> IO a) -> IO a
withContext Connection
conn Config
conf Context -> IO a
action = do
    Context
ctx <- Connection -> Config -> IO Context
newContext Connection
conn Config
conf
    ThreadManager -> IO a -> (Maybe SomeException -> IO ()) -> IO a
forall a.
ThreadManager -> IO a -> (Maybe SomeException -> IO ()) -> IO a
T.stopAfter (Context -> ThreadManager
ctxThreadManager Context
ctx) (Context -> IO a
action Context
ctx) (\Maybe SomeException
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())

newContext :: Connection -> Config -> IO Context
newContext :: Connection -> Config -> IO Context
newContext Connection
conn Config
conf = do
    InstructionHandler
ctl <- Connection -> IORef IFrame -> InstructionHandler
controlStream Connection
conn (IORef IFrame -> InstructionHandler)
-> IO (IORef IFrame) -> IO InstructionHandler
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IFrame -> IO (IORef IFrame)
forall a. a -> IO (IORef a)
newIORef IFrame
IInit
    (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
        hooks :: Hooks
hooks = Config -> Hooks
confHooks Config
conf
        mysa :: SockAddr
mysa = ConnectionInfo -> SockAddr
localSockAddr ConnectionInfo
info
        peersa :: SockAddr
peersa = ConnectionInfo -> SockAddr
remoteSockAddr ConnectionInfo
info
    ThreadManager
mgr <- Manager -> IO ThreadManager
T.newThreadManager (Manager -> IO ThreadManager) -> Manager -> IO ThreadManager
forall a b. (a -> b) -> a -> b
$ Config -> Manager
confTimeoutManager Config
conf
    Context -> IO Context
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Context -> IO Context) -> Context -> IO Context
forall a b. (a -> b) -> a -> b
$
        Context
            { ctxConnection :: Connection
ctxConnection = Connection
conn
            , ctxQEncoder :: QEncoder
ctxQEncoder = QEncoder
enc
            , ctxQDecoder :: QDecoder
ctxQDecoder = QDecoder
dec
            , ctxUniSwitch :: H3StreamType -> InstructionHandler
ctxUniSwitch = H3StreamType -> InstructionHandler
sw
            , ctxPReadMaker :: PositionReadMaker
ctxPReadMaker = PositionReadMaker
preadM
            , ctxThreadManager :: ThreadManager
ctxThreadManager = ThreadManager
mgr
            , ctxHooks :: Hooks
ctxHooks = Hooks
hooks
            , ctxMySockAddr :: SockAddr
ctxMySockAddr = SockAddr
mysa
            , ctxPeerSockAddr :: SockAddr
ctxPeerSockAddr = SockAddr
peersa
            }
  where
    abortWith :: ApplicationProtocolError -> E.SomeException -> IO ()
    abortWith :: ApplicationProtocolError -> SomeException -> IO ()
abortWith ApplicationProtocolError
aerr SomeException
se
        | SomeException -> Bool
forall e. Exception e => e -> Bool
isAsyncException SomeException
se = SomeException -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO SomeException
se
        | Bool
otherwise = do
            SomeException -> IO ()
forall a. Show a => a -> IO ()
print SomeException
se
            Connection -> ApplicationProtocolError -> ReasonPhrase -> IO ()
abortConnection Connection
conn ApplicationProtocolError
aerr ReasonPhrase
""

isAsyncException :: E.Exception e => e -> Bool
isAsyncException :: forall e. Exception e => e -> Bool
isAsyncException e
e =
    case SomeException -> Maybe SomeAsyncException
forall e. Exception e => SomeException -> Maybe e
E.fromException (e -> SomeException
forall e. Exception e => e -> SomeException
E.toException e
e) of
        Just (E.SomeAsyncException e
_) -> Bool
True
        Maybe SomeAsyncException
Nothing -> Bool
False

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{SockAddr
Connection
ThreadManager
Hooks
PositionReadMaker
QEncoder
QDecoder
H3StreamType -> InstructionHandler
ctxConnection :: Context -> Connection
ctxQEncoder :: Context -> QEncoder
ctxQDecoder :: Context -> QDecoder
ctxUniSwitch :: Context -> H3StreamType -> InstructionHandler
ctxPReadMaker :: Context -> PositionReadMaker
ctxThreadManager :: Context -> ThreadManager
ctxHooks :: Context -> Hooks
ctxMySockAddr :: Context -> SockAddr
ctxPeerSockAddr :: Context -> SockAddr
ctxConnection :: Connection
ctxQEncoder :: QEncoder
ctxQDecoder :: QDecoder
ctxUniSwitch :: H3StreamType -> InstructionHandler
ctxPReadMaker :: PositionReadMaker
ctxThreadManager :: ThreadManager
ctxHooks :: Hooks
ctxMySockAddr :: SockAddr
ctxPeerSockAddr :: SockAddr
..} = Connection -> Bool
forall a. Connector a => a -> Bool
isServer Connection
ctxConnection

isH3Client :: Context -> Bool
isH3Client :: Context -> Bool
isH3Client Context{SockAddr
Connection
ThreadManager
Hooks
PositionReadMaker
QEncoder
QDecoder
H3StreamType -> InstructionHandler
ctxConnection :: Context -> Connection
ctxQEncoder :: Context -> QEncoder
ctxQDecoder :: Context -> QDecoder
ctxUniSwitch :: Context -> H3StreamType -> InstructionHandler
ctxPReadMaker :: Context -> PositionReadMaker
ctxThreadManager :: Context -> ThreadManager
ctxHooks :: Context -> Hooks
ctxMySockAddr :: Context -> SockAddr
ctxPeerSockAddr :: Context -> SockAddr
ctxConnection :: Connection
ctxQEncoder :: QEncoder
ctxQDecoder :: QDecoder
ctxUniSwitch :: H3StreamType -> InstructionHandler
ctxPReadMaker :: PositionReadMaker
ctxThreadManager :: ThreadManager
ctxHooks :: Hooks
ctxMySockAddr :: SockAddr
ctxPeerSockAddr :: SockAddr
..} = Connection -> Bool
forall a. Connector a => a -> Bool
isClient Connection
ctxConnection

accept :: Context -> IO Stream
accept :: Context -> IO Stream
accept Context{SockAddr
Connection
ThreadManager
Hooks
PositionReadMaker
QEncoder
QDecoder
H3StreamType -> InstructionHandler
ctxConnection :: Context -> Connection
ctxQEncoder :: Context -> QEncoder
ctxQDecoder :: Context -> QDecoder
ctxUniSwitch :: Context -> H3StreamType -> InstructionHandler
ctxPReadMaker :: Context -> PositionReadMaker
ctxThreadManager :: Context -> ThreadManager
ctxHooks :: Context -> Hooks
ctxMySockAddr :: Context -> SockAddr
ctxPeerSockAddr :: Context -> SockAddr
ctxConnection :: Connection
ctxQEncoder :: QEncoder
ctxQDecoder :: QDecoder
ctxUniSwitch :: H3StreamType -> InstructionHandler
ctxPReadMaker :: PositionReadMaker
ctxThreadManager :: ThreadManager
ctxHooks :: Hooks
ctxMySockAddr :: SockAddr
ctxPeerSockAddr :: SockAddr
..} = Connection -> IO Stream
acceptStream Connection
ctxConnection

qpackEncode :: Context -> QEncoder
qpackEncode :: Context -> QEncoder
qpackEncode Context{SockAddr
Connection
ThreadManager
Hooks
PositionReadMaker
QEncoder
QDecoder
H3StreamType -> InstructionHandler
ctxConnection :: Context -> Connection
ctxQEncoder :: Context -> QEncoder
ctxQDecoder :: Context -> QDecoder
ctxUniSwitch :: Context -> H3StreamType -> InstructionHandler
ctxPReadMaker :: Context -> PositionReadMaker
ctxThreadManager :: Context -> ThreadManager
ctxHooks :: Context -> Hooks
ctxMySockAddr :: Context -> SockAddr
ctxPeerSockAddr :: Context -> SockAddr
ctxConnection :: Connection
ctxQEncoder :: QEncoder
ctxQDecoder :: QDecoder
ctxUniSwitch :: H3StreamType -> InstructionHandler
ctxPReadMaker :: PositionReadMaker
ctxThreadManager :: ThreadManager
ctxHooks :: Hooks
ctxMySockAddr :: SockAddr
ctxPeerSockAddr :: SockAddr
..} = QEncoder
ctxQEncoder

qpackDecode :: Context -> QDecoder
qpackDecode :: Context -> QDecoder
qpackDecode Context{SockAddr
Connection
ThreadManager
Hooks
PositionReadMaker
QEncoder
QDecoder
H3StreamType -> InstructionHandler
ctxConnection :: Context -> Connection
ctxQEncoder :: Context -> QEncoder
ctxQDecoder :: Context -> QDecoder
ctxUniSwitch :: Context -> H3StreamType -> InstructionHandler
ctxPReadMaker :: Context -> PositionReadMaker
ctxThreadManager :: Context -> ThreadManager
ctxHooks :: Context -> Hooks
ctxMySockAddr :: Context -> SockAddr
ctxPeerSockAddr :: Context -> SockAddr
ctxConnection :: Connection
ctxQEncoder :: QEncoder
ctxQDecoder :: QDecoder
ctxUniSwitch :: H3StreamType -> InstructionHandler
ctxPReadMaker :: PositionReadMaker
ctxThreadManager :: ThreadManager
ctxHooks :: Hooks
ctxMySockAddr :: SockAddr
ctxPeerSockAddr :: SockAddr
..} = QDecoder
ctxQDecoder

unidirectional :: Context -> Stream -> IO ()
unidirectional :: Context -> Stream -> IO ()
unidirectional Context{SockAddr
Connection
ThreadManager
Hooks
PositionReadMaker
QEncoder
QDecoder
H3StreamType -> InstructionHandler
ctxConnection :: Context -> Connection
ctxQEncoder :: Context -> QEncoder
ctxQDecoder :: Context -> QDecoder
ctxUniSwitch :: Context -> H3StreamType -> InstructionHandler
ctxPReadMaker :: Context -> PositionReadMaker
ctxThreadManager :: Context -> ThreadManager
ctxHooks :: Context -> Hooks
ctxMySockAddr :: Context -> SockAddr
ctxPeerSockAddr :: Context -> SockAddr
ctxConnection :: Connection
ctxQEncoder :: QEncoder
ctxQDecoder :: QDecoder
ctxUniSwitch :: H3StreamType -> InstructionHandler
ctxPReadMaker :: PositionReadMaker
ctxThreadManager :: ThreadManager
ctxHooks :: Hooks
ctxMySockAddr :: SockAddr
ctxPeerSockAddr :: SockAddr
..} 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 (Maybe a)
withHandle :: forall a. Context -> (Handle -> IO a) -> IO (Maybe a)
withHandle Context{SockAddr
Connection
ThreadManager
Hooks
PositionReadMaker
QEncoder
QDecoder
H3StreamType -> InstructionHandler
ctxConnection :: Context -> Connection
ctxQEncoder :: Context -> QEncoder
ctxQDecoder :: Context -> QDecoder
ctxUniSwitch :: Context -> H3StreamType -> InstructionHandler
ctxPReadMaker :: Context -> PositionReadMaker
ctxThreadManager :: Context -> ThreadManager
ctxHooks :: Context -> Hooks
ctxMySockAddr :: Context -> SockAddr
ctxPeerSockAddr :: Context -> SockAddr
ctxConnection :: Connection
ctxQEncoder :: QEncoder
ctxQDecoder :: QDecoder
ctxUniSwitch :: H3StreamType -> InstructionHandler
ctxPReadMaker :: PositionReadMaker
ctxThreadManager :: ThreadManager
ctxHooks :: Hooks
ctxMySockAddr :: SockAddr
ctxPeerSockAddr :: SockAddr
..} = ThreadManager -> IO () -> (Handle -> IO a) -> IO (Maybe a)
forall a.
ThreadManager -> IO () -> (Handle -> IO a) -> IO (Maybe a)
T.withHandle ThreadManager
ctxThreadManager (() -> 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{SockAddr
Connection
ThreadManager
Hooks
PositionReadMaker
QEncoder
QDecoder
H3StreamType -> InstructionHandler
ctxConnection :: Context -> Connection
ctxQEncoder :: Context -> QEncoder
ctxQDecoder :: Context -> QDecoder
ctxUniSwitch :: Context -> H3StreamType -> InstructionHandler
ctxPReadMaker :: Context -> PositionReadMaker
ctxThreadManager :: Context -> ThreadManager
ctxHooks :: Context -> Hooks
ctxMySockAddr :: Context -> SockAddr
ctxPeerSockAddr :: Context -> SockAddr
ctxConnection :: Connection
ctxQEncoder :: QEncoder
ctxQDecoder :: QDecoder
ctxUniSwitch :: H3StreamType -> InstructionHandler
ctxPReadMaker :: PositionReadMaker
ctxThreadManager :: ThreadManager
ctxHooks :: Hooks
ctxMySockAddr :: SockAddr
ctxPeerSockAddr :: SockAddr
..} = Connection -> IO Stream
stream Connection
ctxConnection

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

forkManaged :: Context -> String -> IO () -> IO ()
forkManaged :: Context -> String -> IO () -> IO ()
forkManaged Context{SockAddr
Connection
ThreadManager
Hooks
PositionReadMaker
QEncoder
QDecoder
H3StreamType -> InstructionHandler
ctxConnection :: Context -> Connection
ctxQEncoder :: Context -> QEncoder
ctxQDecoder :: Context -> QDecoder
ctxUniSwitch :: Context -> H3StreamType -> InstructionHandler
ctxPReadMaker :: Context -> PositionReadMaker
ctxThreadManager :: Context -> ThreadManager
ctxHooks :: Context -> Hooks
ctxMySockAddr :: Context -> SockAddr
ctxPeerSockAddr :: Context -> SockAddr
ctxConnection :: Connection
ctxQEncoder :: QEncoder
ctxQDecoder :: QDecoder
ctxUniSwitch :: H3StreamType -> InstructionHandler
ctxPReadMaker :: PositionReadMaker
ctxThreadManager :: ThreadManager
ctxHooks :: Hooks
ctxMySockAddr :: SockAddr
ctxPeerSockAddr :: SockAddr
..} = ThreadManager -> String -> IO () -> IO ()
T.forkManaged ThreadManager
ctxThreadManager

forkManagedTimeout :: Context -> String -> (T.Handle -> IO ()) -> IO ()
forkManagedTimeout :: Context -> String -> (Handle -> IO ()) -> IO ()
forkManagedTimeout Context{SockAddr
Connection
ThreadManager
Hooks
PositionReadMaker
QEncoder
QDecoder
H3StreamType -> InstructionHandler
ctxConnection :: Context -> Connection
ctxQEncoder :: Context -> QEncoder
ctxQDecoder :: Context -> QDecoder
ctxUniSwitch :: Context -> H3StreamType -> InstructionHandler
ctxPReadMaker :: Context -> PositionReadMaker
ctxThreadManager :: Context -> ThreadManager
ctxHooks :: Context -> Hooks
ctxMySockAddr :: Context -> SockAddr
ctxPeerSockAddr :: Context -> SockAddr
ctxConnection :: Connection
ctxQEncoder :: QEncoder
ctxQDecoder :: QDecoder
ctxUniSwitch :: H3StreamType -> InstructionHandler
ctxPReadMaker :: PositionReadMaker
ctxThreadManager :: ThreadManager
ctxHooks :: Hooks
ctxMySockAddr :: SockAddr
ctxPeerSockAddr :: SockAddr
..} =
    ThreadManager -> String -> (Handle -> IO ()) -> IO ()
T.forkManagedTimeout ThreadManager
ctxThreadManager

forkManagedTimeoutFinally
    :: Context -> String -> (T.Handle -> IO ()) -> IO () -> IO ()
forkManagedTimeoutFinally :: Context -> String -> (Handle -> IO ()) -> IO () -> IO ()
forkManagedTimeoutFinally Context{SockAddr
Connection
ThreadManager
Hooks
PositionReadMaker
QEncoder
QDecoder
H3StreamType -> InstructionHandler
ctxConnection :: Context -> Connection
ctxQEncoder :: Context -> QEncoder
ctxQDecoder :: Context -> QDecoder
ctxUniSwitch :: Context -> H3StreamType -> InstructionHandler
ctxPReadMaker :: Context -> PositionReadMaker
ctxThreadManager :: Context -> ThreadManager
ctxHooks :: Context -> Hooks
ctxMySockAddr :: Context -> SockAddr
ctxPeerSockAddr :: Context -> SockAddr
ctxConnection :: Connection
ctxQEncoder :: QEncoder
ctxQDecoder :: QDecoder
ctxUniSwitch :: H3StreamType -> InstructionHandler
ctxPReadMaker :: PositionReadMaker
ctxThreadManager :: ThreadManager
ctxHooks :: Hooks
ctxMySockAddr :: SockAddr
ctxPeerSockAddr :: SockAddr
..} =
    ThreadManager -> String -> (Handle -> IO ()) -> IO () -> IO ()
T.forkManagedTimeoutFinally ThreadManager
ctxThreadManager

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