{-# 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.Socket (Socket)
import Network.TLS (cipherID)
import Network.Wai
import Network.Wai.Handler.Warp hiding (run)
import Network.Wai.Handler.Warp.Internal hiding (Connection)

-- | QUIC server settings.
type QUICSettings = ServerConfig

runQUICSocket :: QUICSettings -> Settings -> Socket -> Application -> IO ()
runQUICSocket :: QUICSettings -> Settings -> Socket -> Application -> IO ()
runQUICSocket QUICSettings
quicsettings Settings
settings Socket
sock Application
app =
    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 ->
        [Socket] -> QUICSettings -> (Connection -> IO ()) -> IO ()
Q.runWithSockets [Socket
sock] QUICSettings
quicsettings ((Connection -> IO ()) -> IO ()) -> (Connection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Settings -> Application -> InternalInfo -> Connection -> IO ()
quicApp Settings
settings Application
app InternalInfo
ii

runQUICSockets :: QUICSettings -> Settings -> [Socket] -> Application -> IO ()
runQUICSockets :: QUICSettings -> Settings -> [Socket] -> Application -> IO ()
runQUICSockets QUICSettings
quicsettings Settings
settings [Socket]
ss Application
app =
    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 ->
        [Socket] -> QUICSettings -> (Connection -> IO ()) -> IO ()
Q.runWithSockets [Socket]
ss QUICSettings
quicsettings ((Connection -> IO ()) -> IO ()) -> (Connection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Settings -> Application -> InternalInfo -> Connection -> IO ()
quicApp Settings
settings Application
app InternalInfo
ii

-- | Running warp with HTTP/3 on QUIC.
runQUIC :: QUICSettings -> Settings -> Application -> IO ()
runQUIC :: QUICSettings -> Settings -> Application -> IO ()
runQUIC QUICSettings
quicsettings Settings
settings Application
app =
    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
$ Settings -> Application -> InternalInfo -> Connection -> IO ()
quicApp Settings
settings Application
app InternalInfo
ii

quicApp
    :: Settings
    -> Application
    -> InternalInfo
    -> Connection
    -> IO ()
quicApp :: Settings -> Application -> InternalInfo -> Connection -> IO ()
quicApp Settings
settings Application
app InternalInfo
ii 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
                { 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 =
            Config
H3.defaultConfig
                { H3.confPositionReadMaker = pread
                , H3.confTimeoutManager = timmgr
                }
    case Maybe ByteString
malpn of
        Maybe ByteString
Nothing -> () -> IO ()
forall a. a -> IO a
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
                label :: String
label
                    | ByteString
"h3" ByteString -> ByteString -> Bool
`BS.isPrefixOf` ByteString
appProto = String
"Warp HTTP/3"
                    | Bool
otherwise = String
"Warp HQ"
            Connection -> Config -> Server -> IO ()
runX Connection
conn Config
conf (Server -> IO ()) -> Server -> IO ()
forall a b. (a -> b) -> a -> b
$ String
-> Settings
-> InternalInfo
-> Transport
-> SockAddr
-> Application
-> Server
http2server String
label Settings
settings InternalInfo
ii Transport
transport SockAddr
addr Application
app