{-# LANGUAGE OverloadedStrings #-}
module Network.Wai.Handler.WarpQUIC where
import qualified Data.ByteString as BS
import qualified Network.HQ.Server as HQ
import qualified Network.HTTP3.Server as H3
import Network.QUIC
import Network.QUIC.Server as Q
import Network.TLS (cipherID)
import Network.Wai
import Network.Wai.Handler.Warp hiding (run)
import Network.Wai.Handler.Warp.Internal
type QUICSettings = ServerConfig
runQUIC :: QUICSettings -> Settings -> Application -> IO ()
runQUIC :: QUICSettings -> Settings -> Application -> IO ()
runQUIC QUICSettings
quicsettings Settings
settings Application
app = do
Settings -> (InternalInfo -> IO ()) -> IO ()
forall a. Settings -> (InternalInfo -> IO a) -> IO a
withII Settings
settings ((InternalInfo -> IO ()) -> IO ())
-> (InternalInfo -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \InternalInfo
ii ->
QUICSettings -> (Connection -> IO ()) -> IO ()
Q.run QUICSettings
quicsettings ((Connection -> IO ()) -> IO ()) -> (Connection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
ConnectionInfo
info <- Connection -> IO ConnectionInfo
getConnectionInfo Connection
conn
Maybe CertificateChain
mccc <- Connection -> IO (Maybe CertificateChain)
clientCertificateChain Connection
conn
let addr :: SockAddr
addr = ConnectionInfo -> SockAddr
remoteSockAddr ConnectionInfo
info
malpn :: Maybe ByteString
malpn = ConnectionInfo -> Maybe ByteString
alpn ConnectionInfo
info
transport :: Transport
transport = QUIC :: Maybe ByteString -> Word16 -> Maybe CertificateChain -> Transport
QUIC {
quicNegotiatedProtocol :: Maybe ByteString
quicNegotiatedProtocol = Maybe ByteString
malpn
, quicChiperID :: Word16
quicChiperID = Cipher -> Word16
cipherID (Cipher -> Word16) -> Cipher -> Word16
forall a b. (a -> b) -> a -> b
$ ConnectionInfo -> Cipher
cipher ConnectionInfo
info
, quicClientCertificate :: Maybe CertificateChain
quicClientCertificate = Maybe CertificateChain
mccc
}
pread :: PositionReadMaker
pread = InternalInfo -> PositionReadMaker
pReadMaker InternalInfo
ii
timmgr :: Manager
timmgr = InternalInfo -> Manager
timeoutManager InternalInfo
ii
conf :: Config
conf = Hooks -> PositionReadMaker -> Manager -> Config
H3.Config Hooks
H3.defaultHooks PositionReadMaker
pread Manager
timmgr
case Maybe ByteString
malpn of
Maybe ByteString
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ByteString
appProto -> do
let runX :: Connection -> Config -> Server -> IO ()
runX | ByteString
"h3" ByteString -> ByteString -> Bool
`BS.isPrefixOf` ByteString
appProto = Connection -> Config -> Server -> IO ()
H3.run
| Bool
otherwise = Connection -> Config -> Server -> IO ()
HQ.run
Connection -> Config -> Server -> IO ()
runX Connection
conn Config
conf (Server -> IO ()) -> Server -> IO ()
forall a b. (a -> b) -> a -> b
$ Settings
-> InternalInfo -> Transport -> SockAddr -> Application -> Server
http2server Settings
settings InternalInfo
ii Transport
transport SockAddr
addr Application
app