{-# LANGUAGE OverloadedStrings #-}

-- | WAI handler for HTTP/3 based on QUIC.
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

-- | QUIC server settings.
type QUICSettings = ServerConfig

-- | Running warp with HTTP/3 on QUIC.
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