Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-http2 for openSUSE:Factory checked in at 2022-02-11 23:09:12 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-http2 (Old) and /work/SRC/openSUSE:Factory/.ghc-http2.new.1956 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-http2" Fri Feb 11 23:09:12 2022 rev:8 rq:953488 version:3.0.3 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-http2/ghc-http2.changes 2021-06-23 17:38:29.332492691 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-http2.new.1956/ghc-http2.changes 2022-02-11 23:11:07.463243565 +0100 @@ -1,0 +2,15 @@ +Tue Jan 25 03:13:40 UTC 2022 - Peter Simons <psim...@suse.com> + +- Update http2 to version 3.0.3. + ## 3.0.3 + + * Return correct status messages in HTTP2 client + (#31)[https://github.com/kazu-yamamoto/http2/pull/31] + * Follow changes in Aeson 2 + (#32)[https://github.com/kazu-yamamoto/http2/pull/32] + * Make sure connection preface is always sent first + (#33)[https://github.com/kazu-yamamoto/http2/pull/33] + * Avoid empty data + (#34)[https://github.com/kazu-yamamoto/http2/pull/34] + +------------------------------------------------------------------- Old: ---- http2-3.0.2.tar.gz New: ---- http2-3.0.3.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-http2.spec ++++++ --- /var/tmp/diff_new_pack.h5bnX3/_old 2022-02-11 23:11:07.987245081 +0100 +++ /var/tmp/diff_new_pack.h5bnX3/_new 2022-02-11 23:11:07.991245092 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-http2 # -# Copyright (c) 2021 SUSE LLC +# Copyright (c) 2022 SUSE LLC # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,7 +19,7 @@ %global pkg_name http2 %bcond_with tests Name: ghc-%{pkg_name} -Version: 3.0.2 +Version: 3.0.3 Release: 0 Summary: HTTP/2 library License: BSD-3-Clause @@ -27,6 +27,7 @@ Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel BuildRequires: ghc-array-devel +BuildRequires: ghc-async-devel BuildRequires: ghc-bytestring-devel BuildRequires: ghc-case-insensitive-devel BuildRequires: ghc-containers-devel @@ -43,7 +44,6 @@ BuildRequires: ghc-Glob-devel BuildRequires: ghc-aeson-devel BuildRequires: ghc-aeson-pretty-devel -BuildRequires: ghc-async-devel BuildRequires: ghc-base16-bytestring-devel BuildRequires: ghc-cryptonite-devel BuildRequires: ghc-directory-devel ++++++ http2-3.0.2.tar.gz -> http2-3.0.3.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http2-3.0.2/ChangeLog.md new/http2-3.0.3/ChangeLog.md --- old/http2-3.0.2/ChangeLog.md 2021-06-10 03:44:58.000000000 +0200 +++ new/http2-3.0.3/ChangeLog.md 2001-09-09 03:46:40.000000000 +0200 @@ -1,3 +1,14 @@ +## 3.0.3 + +* Return correct status messages in HTTP2 client + (#31)[https://github.com/kazu-yamamoto/http2/pull/31] +* Follow changes in Aeson 2 + (#32)[https://github.com/kazu-yamamoto/http2/pull/32] +* Make sure connection preface is always sent first + (#33)[https://github.com/kazu-yamamoto/http2/pull/33] +* Avoid empty data + (#34)[https://github.com/kazu-yamamoto/http2/pull/34] + ## 3.0.2 * Skip inserting entries that do not fit in the encoding table diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http2-3.0.2/Network/HTTP2/Arch/Sender.hs new/http2-3.0.3/Network/HTTP2/Arch/Sender.hs --- old/http2-3.0.2/Network/HTTP2/Arch/Sender.hs 2021-06-10 03:44:58.000000000 +0200 +++ new/http2-3.0.3/Network/HTTP2/Arch/Sender.hs 2001-09-09 03:46:40.000000000 +0200 @@ -272,6 +272,12 @@ kvlen <- headerContinue streamNumber ths True off0 sendHeadersIfNecessary $ off0 + frameHeaderLength + kvlen + fillDataHeaderEnqueueNext _ + off 0 (Just next) tlrmkr _ out = do + let out' = out { outputType = ONext next tlrmkr } + enqueueOutput outputQ out' + return off + fillDataHeaderEnqueueNext Stream{streamWindow,streamNumber} off datPayloadLen (Just next) tlrmkr _ out = do let buf = confWriteBuffer `plusPtr` off diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http2-3.0.2/Network/HTTP2/Arch/Status.hs new/http2-3.0.3/Network/HTTP2/Arch/Status.hs --- old/http2-3.0.2/Network/HTTP2/Arch/Status.hs 2021-06-10 03:44:58.000000000 +0200 +++ new/http2-3.0.3/Network/HTTP2/Arch/Status.hs 2001-09-09 03:46:40.000000000 +0200 @@ -41,4 +41,4 @@ toStatus :: ByteString -> Maybe H.Status toStatus bs = case C8.readInt bs of Nothing -> Nothing - Just (code,_) -> Just $ H.mkStatus code "fixme" + Just (code,_) -> Just $ toEnum code diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http2-3.0.2/Network/HTTP2/Client/Run.hs new/http2-3.0.3/Network/HTTP2/Client/Run.hs --- old/http2-3.0.2/Network/HTTP2/Client/Run.hs 2021-06-10 03:44:58.000000000 +0200 +++ new/http2-3.0.3/Network/HTTP2/Client/Run.hs 2001-09-09 03:46:40.000000000 +0200 @@ -3,6 +3,7 @@ module Network.HTTP2.Client.Run where +import Control.Concurrent.Async import Control.Concurrent import qualified Control.Exception as E import Data.IORef (writeIORef) @@ -24,15 +25,15 @@ clientInfo <- newClientInfo scheme authority cacheLimit ctx <- newContext clientInfo mgr <- start confTimeoutManager - tid0 <- forkIO $ frameReceiver ctx confReadN - -- fixme: if frameSender is terminated but the main thread is alive, - -- what will happen? - tid1 <- forkIO $ frameSender ctx conf mgr + let runBackgroundThreads = do + race_ + (frameReceiver ctx confReadN) + (frameSender ctx conf mgr) + E.throwIO (ConnectionError ProtocolError "connection terminated") exchangeSettings conf ctx - client (sendRequest ctx scheme authority) `E.finally` do - stop mgr - killThread tid0 - killThread tid1 + fmap (either id id) $ + race runBackgroundThreads (client (sendRequest ctx scheme authority)) + `E.finally` stop mgr sendRequest :: Context -> Scheme -> Authority -> Request -> (Response -> IO a) -> IO a sendRequest ctx@Context{..} scheme auth (Request req) processResponse = do diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http2-3.0.2/http2.cabal new/http2-3.0.3/http2.cabal --- old/http2-3.0.2/http2.cabal 2021-06-10 03:44:58.000000000 +0200 +++ new/http2-3.0.3/http2.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,5 @@ Name: http2 -Version: 3.0.2 +Version: 3.0.3 Author: Kazu Yamamoto <k...@iij.ad.jp> Maintainer: Kazu Yamamoto <k...@iij.ad.jp> License: BSD3 @@ -119,6 +119,7 @@ Network.HTTP2.Server.Worker Build-Depends: base >= 4.9 && < 5 , array + , async , bytestring >= 0.10 , case-insensitive , containers >= 0.5 @@ -169,6 +170,7 @@ , hspec >= 1.3 , http-types , http2 + , network , network-run >= 0.1.0 , typed-process Default-Extensions: Strict StrictData @@ -206,7 +208,7 @@ HPACKSpec JSON Build-Depends: base >= 4.9 && < 5 - , aeson + , aeson >= 2 , base16-bytestring >= 1.0 , bytestring , directory @@ -230,7 +232,7 @@ JSON Build-Depends: base >= 4.9 && < 5 , Glob >= 0.9 - , aeson + , aeson >= 2 , aeson-pretty , base16-bytestring >= 1.0 , bytestring @@ -293,7 +295,7 @@ Other-Modules: HPACKEncode JSON Build-Depends: base >= 4.9 && < 5 - , aeson + , aeson >= 2 , aeson-pretty , array , base16-bytestring >= 1.0 @@ -320,7 +322,7 @@ Other-Modules: HPACKDecode JSON Build-Depends: base >= 4.9 && < 5 - , aeson + , aeson >= 2 , array , base16-bytestring >= 1.0 , bytestring @@ -345,7 +347,7 @@ Main-Is: hpack-stat.hs Other-Modules: JSON Build-Depends: base >= 4.9 && < 5 - , aeson + , aeson >= 2 , aeson-pretty , array , bytestring @@ -373,7 +375,7 @@ Other-Modules: Case JSON Build-Depends: base >= 4.9 && < 5 - , aeson + , aeson >= 2 , aeson-pretty , base16-bytestring >= 1.0 , bytestring diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http2-3.0.2/test/HTTP2/ServerSpec.hs new/http2-3.0.3/test/HTTP2/ServerSpec.hs --- old/http2-3.0.2/test/HTTP2/ServerSpec.hs 2021-06-10 03:44:58.000000000 +0200 +++ new/http2-3.0.3/test/HTTP2/ServerSpec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -10,16 +10,20 @@ import Crypto.Hash (Context, SHA1) -- cryptonite import qualified Crypto.Hash as CH import qualified Data.ByteString as B -import Data.ByteString.Builder (byteString) +import Data.ByteString.Builder (byteString, Builder) import Data.ByteString.Char8 import qualified Data.ByteString.Char8 as C8 +import Data.IORef import Network.HTTP.Types import Network.Run.TCP +import Network.Socket +import Network.Socket.ByteString import Test.Hspec import Network.HPACK import qualified Network.HTTP2.Client as C import Network.HTTP2.Server +import Network.HTTP2.Frame port :: String port = "8080" @@ -33,7 +37,18 @@ it "handles normal cases" $ E.bracket (forkIO runServer) killThread $ \_ -> do threadDelay 10000 - runClient + (runClient allocSimpleConfig) + it "should always send the connection preface first" $ do + prefaceVar <- newEmptyMVar + E.bracket (forkIO (runFakeServer prefaceVar)) killThread $ \_ -> do + threadDelay 10000 + E.catch (runClient allocSlowPrefaceConfig) ignoreHTTP2Error + + preface <- takeMVar prefaceVar + preface `shouldBe` connectionPreface + +ignoreHTTP2Error :: HTTP2Error -> IO () +ignoreHTTP2Error _ = pure () runServer :: IO () runServer = runTCPServer (Just host) port runHTTP2Server @@ -42,10 +57,32 @@ freeSimpleConfig (`run` server) +runFakeServer :: MVar ByteString -> IO () +runFakeServer prefaceVar = do + runTCPServer (Just host) port $ \s -> do + ref <- newIORef Nothing + + -- send settings + sendAll s $ "\x00\x00\x12\x04\x00\x00\x00\x00\x00" + `mappend` "\x00\x03\x00\x00\x00\x80\x00\x04\x00" + `mappend` "\x01\x00\x00\x00\x05\x00\xff\xff\xff" + + -- receive preface + value <- defaultReadN s ref (B.length connectionPreface) + putMVar prefaceVar value + + -- send goaway frame + sendAll s "\x00\x00\x08\x07\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x01" + + -- wait for a few ms to make sure the client has a chance to close the + -- socket on its end + threadDelay 10000 + server :: Server server req _aux sendResponse = case requestMethod req of Just "GET" -> case requestPath req of Just "/" -> sendResponse responseHello [] + Just "/stream" -> sendResponse responseInfinite [] Just "/push" -> do let pp = pushPromise "/push-pp" responsePP 0 sendResponse responseHello [pp] @@ -68,6 +105,15 @@ ,("x-push", "True")] body = byteString "Push\n" +responseInfinite :: Response +responseInfinite = responseStreaming ok200 header body + where + header = [("Content-Type", "text/plain")] + body :: (Builder -> IO ()) -> IO () -> IO () + body write flush = do + let go n = write (byteString (C8.pack (show n)) `mappend` "\n") *> flush *> go (succ n) + go (0 :: Int) + response404 :: Response response404 = responseNoBody notFound404 [] @@ -100,22 +146,36 @@ where !ctx' = CH.hashUpdate ctx bs -runClient :: IO () -runClient = runTCPClient host port $ runHTTP2Client +runClient :: (Socket -> BufferSize -> IO Config) -> IO () +runClient allocConfig = + runTCPClient host port $ runHTTP2Client where authority = C8.pack host cliconf = C.ClientConfig "http" authority 20 - runHTTP2Client s = E.bracket (allocSimpleConfig s 4096) + runHTTP2Client s = E.bracket (allocConfig s 4096) freeSimpleConfig (\conf -> C.run cliconf conf client) client sendRequest = mapConcurrently_ ($ sendRequest) clients - clients = [client0,client1,client2,client3,client4] + clients = [client0,client1,client2,client3,client4,client5] + +-- delay sending preface to be able to test if it is always sent first +allocSlowPrefaceConfig :: Socket -> BufferSize -> IO Config +allocSlowPrefaceConfig s size = do + config <- allocSimpleConfig s size + pure config { confSendAll = slowPrefaceSend (confSendAll config) } + where + slowPrefaceSend :: (ByteString -> IO ()) -> ByteString -> IO () + slowPrefaceSend orig chunk = do + when (C8.pack "PRI" `isPrefixOf` chunk) $ do + threadDelay 10000 + orig chunk client0 :: C.Client () client0 sendRequest = do let req = C.requestNoBody methodGet "/" [] sendRequest req $ \rsp -> do C.responseStatus rsp `shouldBe` Just ok200 + fmap statusMessage (C.responseStatus rsp) `shouldBe` Just "OK" client1 :: C.Client () client1 sendRequest = do @@ -152,5 +212,15 @@ sendRequest req1 $ \rsp -> do C.responseStatus rsp `shouldBe` Just ok200 +client5 :: C.Client () +client5 sendRequest = do + let req0 = C.requestNoBody methodGet "/stream" [] + sendRequest req0 $ \rsp -> do + C.responseStatus rsp `shouldBe` Just ok200 + let go n | n > 0 = do _ <- C.getResponseBodyChunk rsp + go (pred n) + | otherwise = pure () + go (100 :: Int) + firstTrailerValue :: HeaderTable -> HeaderValue firstTrailerValue = snd . Prelude.head . fst diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http2-3.0.2/test-frame/JSON.hs new/http2-3.0.3/test-frame/JSON.hs --- old/http2-3.0.2/test-frame/JSON.hs 2021-06-10 03:44:58.000000000 +0200 +++ new/http2-3.0.3/test-frame/JSON.hs 2001-09-09 03:46:40.000000000 +0200 @@ -14,7 +14,7 @@ import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as B8 -import Data.HashMap.Strict (union) +import Data.Aeson.KeyMap (union) import Data.Maybe (fromJust) import Data.Text (Text) import qualified Data.Text as T diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/http2-3.0.2/test-hpack/JSON.hs new/http2-3.0.3/test-hpack/JSON.hs --- old/http2-3.0.2/test-hpack/JSON.hs 2021-06-10 03:44:58.000000000 +0200 +++ new/http2-3.0.3/test-hpack/JSON.hs 2001-09-09 03:46:40.000000000 +0200 @@ -14,7 +14,8 @@ import Data.Aeson import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as B8 -import qualified Data.HashMap.Strict as H +import qualified Data.Aeson.KeyMap as H +import qualified Data.Aeson.Key as Key import Data.Text (Text) import qualified Data.Text as T import Data.Vector ((!)) @@ -83,13 +84,13 @@ parseJSON (Array a) = pure (toKey (a ! 0), toValue (a ! 1)) -- old where toKey = toValue - parseJSON (Object o) = pure (textToByteString k, toValue v) -- new + parseJSON (Object o) = pure (textToByteString (Key.toText k), toValue v) -- new where (k,v) = head $ H.toList o parseJSON _ = mzero instance {-# OVERLAPPING #-} ToJSON Header where - toJSON (k,v) = object [ byteStringToText k .= byteStringToText v ] + toJSON (k,v) = object [ Key.fromText (byteStringToText k) .= byteStringToText v ] textToByteString :: Text -> ByteString textToByteString = B8.pack . T.unpack
