http2 5.4.1 → 5.4.2

raw patch · 11 files changed

+111/−13 lines, 11 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• Network/HTTP2/Client.hs +1/−0
• Network/HTTP2/H2/Config.hs +1/−0
• Network/HTTP2/H2/Context.hs +5/−0
• Network/HTTP2/H2/Receiver.hs +23/−10
• Network/HTTP2/H2/Sender.hs +19/−0
• Network/HTTP2/H2/Types.hs +8/−0
• Network/HTTP2/Server.hs +1/−0
• Network/HTTP2/Server/Worker.hs +15/−0
• http2.cabal +2/−2
• test/HTTP2/ServerSpec.hs +30/−1

@@ -1,5 +1,11 @@ # ChangeLog for http2 +## 5.4.2++* Support informational (1xx) responses, e.g. 103 Early Hints. Servers can send+  them via `auxSendInformational`; clients can observe them via the new+  `confOnInformational` callback in `Config`.+ ## 5.4.1  * Ensure sender notices when receiver has terminated.

@@ -82,6 +82,7 @@     confMySockAddr,     confPeerSockAddr,     confReadNTimeout,+    confOnInformational,     allocSimpleConfig,     allocSimpleConfig',     freeSimpleConfig,

@@ -33,6 +33,7 @@     confMySockAddr <- getSocketName s     confPeerSockAddr <- getPeerName s     let confReadNTimeout = False+    let confOnInformational = \_ _ -> return ()     return Config{..}  -- | Deallocating the resource of the simple configuration.

@@ -92,6 +92,10 @@     , threadManager      :: T.ThreadManager     , receiverDone       :: TVar (Maybe SomeException)     , workersDone        :: STM Bool+    , informationalCallback :: StreamId -> TokenHeaderTable -> IO ()+    -- ^ Client only: called when a 1xx informational response (e.g. 103 Early+    --   Hints) is received, ahead of the final response. Copied from+    --   'confOnInformational'; no-op by default.     } {- FOURMOLU_ENABLE -} @@ -139,6 +143,7 @@     let peerSockAddr = confPeerSockAddr     threadManager   <- T.newThreadManager timmgr     receiverDone    <- newTVarIO Nothing+    let informationalCallback = confOnInformational     let workersDone = fromMaybe (T.isAllGone threadManager) mdone     return Context{..}   where

@@ -387,6 +387,27 @@   where     dep = streamDependency p +-- | Handle a decoded response HEADERS section. On the client, a 1xx+--   informational response (e.g. 103 Early Hints) is delivered to the+--   informational callback and the stream keeps waiting for the final response;+--   otherwise the headers become the (final) response.+onResponseHeaders+    :: Context+    -> StreamId+    -> Maybe ClosedCode+    -> Bool+    -> TokenHeaderTable+    -> IO StreamState+onResponseHeaders ctx streamId hcl endOfStream tbl+    | endOfStream = return $ Open hcl (NoBody tbl)+    | role ctx == Client && isInformational = do+        informationalCallback ctx streamId tbl+        return $ Open hcl JustOpened+    | otherwise = return $ Open hcl (HasBody tbl)+  where+    isInformational =+        maybe False ("1" `BS.isPrefixOf`) $ getFieldValue tokenStatus (snd tbl)+ stream     :: FrameType     -> FrameHeader@@ -416,11 +437,7 @@             if endOfHeader                 then do                     tbl <- hpackDecodeHeader frag streamId ctx-                    return $-                        if endOfStream-                            then -- turned into HalfClosedRemote in processState-                                Open hcl (NoBody tbl)-                            else Open hcl (HasBody tbl)+                    onResponseHeaders ctx streamId hcl endOfStream tbl                 else do                     let siz = BS.length frag                     return $ Open hcl $ Continued [frag] siz 1 endOfStream@@ -522,11 +539,7 @@                 then do                     let hdrblk = BS.concat $ reverse rfrags'                     tbl <- hpackDecodeHeader hdrblk streamId ctx-                    return $-                        if endOfStream-                            then -- turned into HalfClosedRemote in processState-                                Open hcl (NoBody tbl)-                            else Open hcl (HasBody tbl)+                    onResponseHeaders ctx streamId hcl endOfStream tbl                 else return $ Open hcl $ Continued rfrags' siz' n' endOfStream  -- (No state transition)

@@ -167,6 +167,10 @@                         (off', mout') <- outputHeader strm hdr mnext tlrmkr sync off                         sync mout'                         return off'+                    OInformational hdr -> do+                        off' <- outputInformational strm hdr off+                        sync Nothing+                        return off'                     _ -> do                         sws <- getStreamWindowSize strm                         cws <- getConnectionWindowSize ctx -- not 0@@ -209,6 +213,21 @@                 Just next -> do                     let out' = Output strm (ONext next tlrmkr) sync                     return (off, Just out')++        ----------------------------------------------------------------+        -- Emit an informational (1xx) HEADERS section. Unlike 'outputHeader',+        -- this never sets END_STREAM and never half-closes the stream, so the+        -- final response can still be sent afterwards.+        outputInformational+            :: Stream+            -> [Header]+            -> Offset+            -> IO Offset+        outputInformational strm hdr off0 = do+            let sid = streamNumber strm+            (ths, _) <- toTokenHeaderTable $ fixHeaders hdr+            off' <- headerContinue sid ths False {- not endOfStream -} off0+            flushIfNecessary off'          ----------------------------------------------------------------         output :: Output -> Offset -> WindowSize -> IO (Offset, Maybe Output)

@@ -190,6 +190,7 @@     = OHeader [Header] (Maybe DynaNext) TrailersMaker     | OPush TokenHeaderList StreamId -- associated stream id from client     | ONext DynaNext TrailersMaker+    | OInformational [Header]  data Sync = Done | Cont Output @@ -271,6 +272,12 @@     , confPeerSockAddr :: SockAddr     -- ^ This is copied into 'Aux', if exist, on server.     , confReadNTimeout :: Bool+    , confOnInformational :: StreamId -> TokenHeaderTable -> IO ()+    -- ^ Client only: called when a 1xx informational response (e.g. 103 Early+    --   Hints) is received on the given stream, ahead of the final response.+    --   No-op by default.+    --+    --   @since 5.4.2     }  -- | Default config. This is just a template to modify via@@ -287,6 +294,7 @@         , confMySockAddr = SockAddrInet 0 0         , confPeerSockAddr = SockAddrInet 0 0         , confReadNTimeout = False+        , confOnInformational = \_ _ -> return ()         }  isAsyncException :: Exception e => e -> Bool

@@ -62,6 +62,7 @@     confMySockAddr,     confPeerSockAddr,     confReadNTimeout,+    confOnInformational,     allocSimpleConfig,     allocSimpleConfig',     freeSimpleConfig,

@@ -6,6 +6,7 @@ ) where  import Control.Concurrent.STM+import qualified Data.ByteString.Char8 as C8 import Data.IORef import Network.HTTP.Semantics import Network.HTTP.Semantics.IO@@ -29,6 +30,7 @@                     { auxTimeHandle = th                     , auxMySockAddr = mySockAddr                     , auxPeerSockAddr = peerSockAddr+                    , auxSendInformational = sendInformational ctx strm                     }             request = Request req'         lc <- newLoopCheck strm Nothing@@ -45,6 +47,19 @@             bs <- readBody             T.resume th -- this is the same as 'tickle'             return bs++----------------------------------------------------------------++-- | Send an informational (1xx) response, e.g. 103 Early Hints, on the given+--   stream ahead of the final response. This is wired into 'auxSendInformational'+--   so that a server (or WAI handler via Warp) can emit early hints. It blocks+--   until the informational HEADERS have been handed to the sender, preserving+--   ordering with respect to the final response.+sendInformational :: Context -> Stream -> Status -> ResponseHeaders -> IO ()+sendInformational ctx strm st hdrs = do+    lc <- newLoopCheck strm Nothing+    let hdr = (":status", C8.pack (show (statusCode st))) : hdrs+    syncWithSender ctx strm (OInformational hdr) lc  ---------------------------------------------------------------- 

@@ -1,6 +1,6 @@ cabal-version:      >=1.10 name:               http2-version:            5.4.1+version:            5.4.2 license:            BSD3 license-file:       LICENSE maintainer:         Kazu Yamamoto <kazu@iij.ad.jp>@@ -121,7 +121,7 @@         network-byte-order >=0.1.7 && <0.2,         network-control >=0.1 && <0.2,         stm >=2.5 && <2.6,-        time-manager >=0.2.3 && <0.4,+        time-manager >=0.3.0 && <0.4,         unix-time >=0.4.11 && <0.6,         utf8-string >=1.0 && <1.1 

@@ -49,6 +49,17 @@                 threadDelay 10000                 runClient allocSimpleConfig +        it "delivers 103 Early Hints to the client's informational handler" $+            E.bracket (forkIO runServer) killThread $ \_ -> do+                threadDelay 10000+                hintsRef <- newIORef []+                runClientEarly hintsRef >>= (`shouldBe` Just ok200)+                hints <- readIORef hintsRef+                map (getFieldValue (toToken "link") . snd) hints+                    `shouldBe` [ Just "</style.css>; rel=preload; as=style"+                               , Just "</app.js>; rel=preload; as=script"+                               ]+         it "should always send the connection preface first" $ do             prefaceVar <- newEmptyMVar             E.bracket (forkIO (runFakeServer prefaceVar)) killThread $ \_ -> do@@ -103,9 +114,13 @@         threadDelay 10000  server :: Server-server req _aux sendResponse = case requestMethod req of+server req aux sendResponse = case requestMethod req of     Just "GET" -> case requestPath req of         Just "/" -> sendResponse responseHello []+        Just "/early" -> do+            auxSendInformational aux earlyHints103 [("link", "</style.css>; rel=preload; as=style")]+            auxSendInformational aux earlyHints103 [("link", "</app.js>; rel=preload; as=script")]+            sendResponse responseHello []         Just "/stream" -> sendResponse responseInfinite []         Just "/push" -> do             let pp = pushPromise "/push-pp" responsePP 0@@ -122,6 +137,9 @@     header = [("Content-Type", "text/plain")]     body = byteString "Hello, world!\n" +earlyHints103 :: Status+earlyHints103 = mkStatus 103 "Early Hints"+ responsePP :: Response responsePP = responseBuilder ok200 header body   where@@ -172,6 +190,17 @@ trailersMaker ctx (Just bs) = return $ NextTrailersMaker $ trailersMaker ctx'   where     !ctx' = CH.hashUpdate ctx bs++-- | Request @/early@ with an informational handler installed, recording each+-- 103 Early Hints section and returning the final response status.+runClientEarly :: IORef [TokenHeaderTable] -> IO (Maybe Status)+runClientEarly hintsRef = runTCPClient host port $ \s ->+    E.bracket (allocSimpleConfig s 4096) freeSimpleConfig $ \conf0 ->+        C.run cliconf (conf0{confOnInformational = onInformational }) $ \sendRequest _aux ->+            sendRequest (C.requestNoBody methodGet "/early" []) (return . C.responseStatus)+  where+    cliconf = C.defaultClientConfig{C.authority = host}+    onInformational _sid tbl = modifyIORef' hintsRef (++ [tbl])  runClient :: (Socket -> BufferSize -> IO Config) -> IO () runClient allocConfig =