http3 0.0.4 → 0.0.5

raw patch · 10 files changed

+52/−24 lines, 10 filesdep ~http2PVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: http2

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• Network/HQ/Client.hs +2/−1
• Network/HQ/Server.hs +10/−6
• Network/HTTP3/Context.hs +15/−1
• Network/HTTP3/Send.hs +10/−5
• Network/HTTP3/Server.hs +2/−2
• Network/QPACK/Table/Dynamic.hs +1/−0
• http3.cabal +2/−2
• util/ClientX.hs +1/−0
• util/client.hs +5/−7

@@ -1,5 +1,9 @@ # Revision history for http3 +## 0.0.5++* Supporting http2 v4.2.0.+ ## 0.0.4  * Using "crypton" intead of "cryptonite".

@@ -28,6 +28,7 @@  import qualified Data.ByteString as BS import Data.IORef+import Data.Maybe (fromJust) import Network.HPACK import qualified Network.HTTP2.Client as H2 import Network.HTTP2.Client.Internal (Request(..), Response(..))@@ -47,7 +48,7 @@ sendRequest :: Connection -> Request -> (Response -> IO a) -> IO a sendRequest conn (Request outobj) processResponse = E.bracket open close $ \strm -> do     let hdr = H2.outObjHeaders outobj-        Just path = lookup ":path" hdr+        path = fromJust $ lookup ":path" hdr         requestLine = BS.concat ["GET ", path, "\r\n"]     QUIC.sendStream strm requestLine     QUIC.shutdownStream strm

@@ -51,21 +51,23 @@ -- | Running an HQ server. run :: Connection -> Config -> Server -> IO () run conn conf server = do-    myaddr <- QUIC.localSockAddr <$> QUIC.getConnectionInfo conn+    info <- QUIC.getConnectionInfo conn+    let mysa = QUIC.localSockAddr info+        peersa = QUIC.remoteSockAddr info     forever $ do         strm <- QUIC.acceptStream conn-        forkFinally (processRequest conf myaddr server strm) (\_ -> QUIC.closeStream strm)+        forkFinally (processRequest conf mysa peersa server strm) (\_ -> QUIC.closeStream strm) -processRequest :: Config -> SockAddr -> Server -> Stream -> IO ()-processRequest conf myaddr server strm+processRequest :: Config -> SockAddr -> SockAddr -> Server -> Stream -> IO ()+processRequest conf mysa peersa server strm   | QUIC.isClientInitiatedBidirectional sid = do         th <- T.register (confTimeoutManager conf) (return ())-        vt <- recvHeader strm myaddr+        vt <- recvHeader strm mysa         src <- newSource strm         refH <- newIORef Nothing         let readB = readSource src             req = Request $ InpObj vt Nothing readB refH-            aux = Aux th+            aux = Aux th mysa peersa         server req aux $ sendResponse conf strm   | otherwise = return () -- fixme: should consume the data?   where@@ -111,6 +113,8 @@         let next = H2.fillBuilderBodyGetNext builder         sendNext strm next     H2.OutBodyStreaming strmbdy -> sendStreaming strm strmbdy+    H2.OutBodyStreamingUnmask _ ->+        error "sendResponse: server does not support OutBodyStreamingUnmask"  sendNext :: Stream -> H2.DynaNext -> IO () sendNext strm action = do

@@ -20,6 +20,8 @@   , abort   , getHooks   , Hooks(..) -- re-export+  , getMySockAddr+  , getPeerSockAddr   ) where  import Control.Concurrent@@ -28,6 +30,7 @@ import Network.HTTP2.Internal (PositionReadMaker) import Network.QUIC import Network.QUIC.Internal (isServer, isClient, connDebugLog)+import Network.Socket (SockAddr) import System.Mem.Weak import qualified System.TimeManager as T import qualified UnliftIO.Exception as E@@ -45,6 +48,8 @@   , ctxPReadMaker :: PositionReadMaker   , ctxManager    :: T.Manager   , ctxHooks      :: Hooks+  , ctxMySockAddr   :: SockAddr+  , ctxPeerSockAddr :: SockAddr   , ctxThreads    :: IORef [Weak ThreadId]   } @@ -52,13 +57,16 @@ newContext conn conf ctl = do     (enc, handleDI) <- newQEncoder defaultQEncoderConfig     (dec, handleEI) <- newQDecoder defaultQDecoderConfig+    info <- getConnectionInfo conn     let handleDI' recv = handleDI recv `E.catchAny` abortWith QpackDecoderStreamError         handleEI' recv = handleEI recv `E.catchAny` abortWith QpackEncoderStreamError         sw = switch conn ctl handleEI' handleDI'         preadM = confPositionReadMaker conf         timmgr = confTimeoutManager conf         hooks  = confHooks conf-    Context conn enc dec sw preadM timmgr hooks <$> newIORef []+        mysa = localSockAddr info+        peersa = remoteSockAddr info+    Context conn enc dec sw preadM timmgr hooks mysa peersa <$> newIORef []   where     abortWith aerr _se = abortConnection conn aerr "" @@ -129,3 +137,9 @@  getHooks :: Context -> Hooks getHooks = ctxHooks++getMySockAddr :: Context -> SockAddr+getMySockAddr = ctxMySockAddr++getPeerSockAddr :: Context -> SockAddr+getPeerSockAddr = ctxMySockAddr

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}  module Network.HTTP3.Send (     sendHeader@@ -12,9 +13,10 @@ import Foreign.ForeignPtr import Network.HPACK (toHeaderTable) import qualified Network.HTTP.Types as HT-import Network.HTTP2.Internal+import Network.HTTP2.Internal hiding (timeoutClose) import Network.QUIC import qualified System.TimeManager as T+import qualified UnliftIO.Exception as E  import Imports import Network.HTTP3.Context@@ -44,7 +46,8 @@     OutBodyBuilder builder -> do         let next = fillBuilderBodyGetNext builder         sendNext ctx strm th next tlrmkr-    OutBodyStreaming strmbdy -> sendStreaming ctx strm th strmbdy tlrmkr+    OutBodyStreaming strmbdy -> sendStreaming ctx strm th tlrmkr (\unmask push flush -> unmask $ strmbdy push flush)+    OutBodyStreamingUnmask strmbdy -> sendStreaming ctx strm th tlrmkr strmbdy   where     tlrmkr = outObjTrailers outobj @@ -84,10 +87,12 @@         T.tickle th         return (signal, tlrmkr1) -sendStreaming :: Context -> Stream -> T.Handle -> ((Builder -> IO ()) -> IO () -> IO ()) -> TrailersMaker -> IO ()-sendStreaming ctx strm th strmbdy tlrmkr0 = do+sendStreaming :: Context -> Stream -> T.Handle -> TrailersMaker+              -> ((forall x. IO x -> IO x) -> (Builder -> IO ()) -> IO () -> IO ())+              -> IO ()+sendStreaming ctx strm th tlrmkr0 strmbdy = do     ref <- newIORef tlrmkr0-    strmbdy (write ref) flush+    E.mask $ \unmask -> strmbdy unmask (write ref) flush     tlrmkr <- readIORef ref     Trailers trailers <- tlrmkr Nothing     unless (null trailers) $ sendHeader ctx strm th trailers

@@ -130,13 +130,13 @@           case (mMethod, mScheme, mAuthority, mPath) of               (Just "CONNECT", _, Just _, _)   -> return ()               (Just _, Just _, Just _, Just _) -> return ()-              otherwise                        -> QUIC.resetStream strm H3MessageError+              _                                -> QUIC.resetStream strm H3MessageError           -- fixme: Content-Length           refI <- newIORef IInit           refH <- newIORef Nothing           let readB = recvBody ctx src refI refH               req = Request $ InpObj ht Nothing readB refH-          let aux = Aux th+          let aux = Aux th (getMySockAddr ctx) (getPeerSockAddr ctx)           server req aux $ sendResponse ctx strm th   where     reset se

@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} {-# LANGUAGE RecordWildCards #-}  module Network.QPACK.Table.Dynamic where

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               http3-version:            0.0.4+version:            0.0.5 license:            BSD-3-Clause license-file:       LICENSE maintainer:         Kazu Yamamoto <kazu@iij.ad.jp>@@ -81,7 +81,7 @@         bytestring,         case-insensitive,         containers,-        http2 >=4.1.3 && <5,+        http2 >=4.2.0 && <5,         http-types,         network,         network-byte-order,

@@ -2,6 +2,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE Strict #-} {-# LANGUAGE StrictData #-}+{-# LANGUAGE RankNTypes #-}  module ClientX where 

@@ -154,14 +154,12 @@ main = do     args <- getArgs     (opts@Options{..}, ips) <- clientOpts args-    let ipslen = length ips-    when (ipslen /= 2 && ipslen /= 3) $-        showUsageAndExit "cannot recognize <addr> and <port>\n"+    (addr,port,path) <- case ips of+      [a,b]   -> return (a,b,"/")+      [a,b,c] -> return (a,b,c)+      _       -> showUsageAndExit "cannot recognize <addr> and <port>\n"     cmvar <- newEmptyMVar-    let path | ipslen == 3 = ips !! 2-             | otherwise   = "/"-        addr:port:_ = ips-        ccalpn ver+    let ccalpn ver           | optPerformance /= 0 = return $ Just ["perf"]           | otherwise = let (h3X, hqX) = makeProtos ver                             protos | optHQ     = [hqX,h3X]