Hello community, here is the log from the commit of package ghc-warp for openSUSE:Factory checked in at 2016-08-26 23:17:24 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-warp (Old) and /work/SRC/openSUSE:Factory/.ghc-warp.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-warp" Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-warp/ghc-warp.changes 2016-07-20 09:22:27.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-warp.new/ghc-warp.changes 2016-08-26 23:17:26.000000000 +0200 @@ -1,0 +2,5 @@ +Wed Aug 17 18:43:05 UTC 2016 - [email protected] + +- Update to version 3.2.8 revision 0 with cabal2obs. + +------------------------------------------------------------------- Old: ---- warp-3.2.7.tar.gz New: ---- warp-3.2.8.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-warp.spec ++++++ --- /var/tmp/diff_new_pack.X09aVU/_old 2016-08-26 23:17:27.000000000 +0200 +++ /var/tmp/diff_new_pack.X09aVU/_new 2016-08-26 23:17:27.000000000 +0200 @@ -19,15 +19,14 @@ %global pkg_name warp %bcond_with tests Name: ghc-%{pkg_name} -Version: 3.2.7 +Version: 3.2.8 Release: 0 Summary: A fast, light-weight web server for WAI applications License: MIT -Group: System/Libraries +Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel -# Begin cabal-rpm deps: BuildRequires: ghc-array-devel BuildRequires: ghc-async-devel BuildRequires: ghc-auto-update-devel @@ -66,7 +65,6 @@ BuildRequires: ghc-time-devel BuildRequires: ghc-transformers-devel %endif -# End cabal-rpm deps %description HTTP/1.0, HTTP/1.1 and HTTP/2 are supported. For HTTP/2, Warp supports direct @@ -87,20 +85,14 @@ %prep %setup -q -n %{pkg_name}-%{version} - %build %ghc_lib_build - %install %ghc_lib_install - %check -%if %{with tests} -%{cabal} test -%endif - +%cabal_test %post devel %ghc_pkg_recache ++++++ warp-3.2.7.tar.gz -> warp-3.2.8.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.2.7/ChangeLog.md new/warp-3.2.8/ChangeLog.md --- old/warp-3.2.7/ChangeLog.md 2016-07-04 09:23:09.000000000 +0200 +++ new/warp-3.2.8/ChangeLog.md 2016-08-04 07:01:44.000000000 +0200 @@ -1,3 +1,9 @@ +## 3.2.8 + +* Fixing HTTP2 requestBodyLength. [#573](https://github.com/yesodweb/wai/pull/573) +* Making HTTP/2 :path optional for the CONNECT method. [#572](https://github.com/yesodweb/wai/pull/572) +* Adding new APIs for HTTP/2 trailers: http2dataTrailers and modifyHTTP2Data [#566](https://github.com/yesodweb/wai/pull/566) + ## 3.2.7 * Adding new APIs for HTTP/2 server push: getHTTP2Data and setHTTP2Data [#510](https://github.com/yesodweb/wai/pull/510) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.2.7/Network/Wai/Handler/Warp/HTTP2/HPACK.hs new/warp-3.2.8/Network/Wai/Handler/Warp/HTTP2/HPACK.hs --- old/warp-3.2.7/Network/Wai/Handler/Warp/HTTP2/HPACK.hs 2016-07-04 09:23:09.000000000 +0200 +++ new/warp-3.2.8/Network/Wai/Handler/Warp/HTTP2/HPACK.hs 2016-08-04 07:01:44.000000000 +0200 @@ -83,13 +83,21 @@ {-# INLINE checkRequestHeader #-} checkRequestHeader :: ValueTable -> Bool checkRequestHeader reqvt - | getHeaderValue tokenStatus reqvt /= Nothing = False - | getHeaderValue tokenPath reqvt == Nothing = False - | getHeaderValue tokenMethod reqvt == Nothing = False - | getHeaderValue tokenAuthority reqvt == Nothing = False - | getHeaderValue tokenConnection reqvt /= Nothing = False - | just (getHeaderValue tokenTE reqvt) (/= "trailers") = False - | otherwise = True + | mStatus /= Nothing = False + | mMethod == Nothing = False + | mAuthority == Nothing = False + | mConnection /= Nothing = False + | just mTE (/= "trailers") = False + | just mMethod (== "CONNECT") = mPath == Nothing && mScheme == Nothing + | otherwise = mPath /= Nothing + where + mStatus = getHeaderValue tokenStatus reqvt + mScheme = getHeaderValue tokenScheme reqvt + mPath = getHeaderValue tokenPath reqvt + mMethod = getHeaderValue tokenMethod reqvt + mAuthority = getHeaderValue tokenAuthority reqvt + mConnection = getHeaderValue tokenConnection reqvt + mTE = getHeaderValue tokenTE reqvt {-# INLINE just #-} just :: Maybe a -> (a -> Bool) -> Bool diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.2.7/Network/Wai/Handler/Warp/HTTP2/Receiver.hs new/warp-3.2.8/Network/Wai/Handler/Warp/HTTP2/Receiver.hs --- old/warp-3.2.7/Network/Wai/Handler/Warp/HTTP2/Receiver.hs 2016-07-04 09:23:09.000000000 +0200 +++ new/warp-3.2.8/Network/Wai/Handler/Warp/HTTP2/Receiver.hs 2016-08-04 07:01:44.000000000 +0200 @@ -122,7 +122,7 @@ E.throwIO $ StreamError ProtocolError streamId writeIORef streamPrecedence $ toPrecedence pri writeIORef streamState HalfClosed - (!req, !ii) <- mkreq tbl (return "") + (!req, !ii) <- mkreq tbl (Just 0, return "") atomically $ writeTQueue inputQ $ Input strm req reqvt ii Open (HasBody tbl@(_,reqvt) pri) -> do resetContinued @@ -133,7 +133,7 @@ writeIORef streamState $ Open (Body q mcl bodyLength) readQ <- newReadBody q bodySource <- mkSource readQ - (!req, !ii) <- mkreq tbl (readSource bodySource) + (!req, !ii) <- mkreq tbl (mcl, readSource bodySource) atomically $ writeTQueue inputQ $ Input strm req reqvt ii s@(Open Continued{}) -> do setContinued diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.2.7/Network/Wai/Handler/Warp/HTTP2/Request.hs new/warp-3.2.8/Network/Wai/Handler/Warp/HTTP2/Request.hs --- old/warp-3.2.7/Network/Wai/Handler/Warp/HTTP2/Request.hs 2016-07-04 09:23:09.000000000 +0200 +++ new/warp-3.2.8/Network/Wai/Handler/Warp/HTTP2/Request.hs 2016-08-04 07:01:44.000000000 +0200 @@ -6,6 +6,7 @@ , MkReq , getHTTP2Data , setHTTP2Data + , modifyHTTP2Data ) where import Control.Applicative ((<|>)) @@ -29,17 +30,17 @@ import Network.Wai.Internal (Request(..)) import System.IO.Unsafe (unsafePerformIO) -type MkReq = (TokenHeaderList,ValueTable) -> IO ByteString -> IO (Request,InternalInfo) +type MkReq = (TokenHeaderList,ValueTable) -> (Maybe Int,IO ByteString) -> IO (Request,InternalInfo) mkRequest :: InternalInfo1 -> S.Settings -> SockAddr -> MkReq -mkRequest ii1 settings addr (reqths,reqvt) body = do +mkRequest ii1 settings addr (reqths,reqvt) (bodylen,body) = do ref <- newIORef Nothing - mkRequest' ii1 settings addr ref (reqths,reqvt) body + mkRequest' ii1 settings addr ref (reqths,reqvt) (bodylen,body) mkRequest' :: InternalInfo1 -> S.Settings -> SockAddr -> IORef (Maybe HTTP2Data) -> MkReq -mkRequest' ii1 settings addr ref (reqths,reqvt) body = return (req,ii) +mkRequest' ii1 settings addr ref (reqths,reqvt) (bodylen,body) = return (req,ii) where !req = Request { requestMethod = colonMethod @@ -53,7 +54,7 @@ , remoteHost = addr , requestBody = body , vault = vaultValue - , requestBodyLength = ChunkedBody -- fixme + , requestBodyLength = maybe ChunkedBody (KnownLength . fromIntegral) bodylen , requestHeaderHost = mHost <|> mAuth , requestHeaderRange = mRange , requestHeaderReferer = mReferer @@ -66,14 +67,16 @@ Nothing -> case mAuth of Just auth -> (tokenHost, auth) : reqths _ -> reqths - !colonPath = fromJust $ getHeaderValue tokenPath reqvt -- MUST + !mPath = getHeaderValue tokenPath reqvt -- SHOULD !colonMethod = fromJust $ getHeaderValue tokenMethod reqvt -- MUST !mAuth = getHeaderValue tokenAuthority reqvt -- SHOULD !mHost = getHeaderValue tokenHost reqvt !mRange = getHeaderValue tokenRange reqvt !mReferer = getHeaderValue tokenReferer reqvt !mUserAgent = getHeaderValue tokenUserAgent reqvt - (unparsedPath,query) = B8.break (=='?') colonPath + -- CONNECT request will have ":path" omitted, use ":authority" as unparsed + -- path instead so that it will have consistent behavior compare to HTTP 1.0 + (unparsedPath,query) = B8.break (=='?') $ fromJust (mPath <|> mAuth) !path = H.extractPath unparsedPath !rawPath = if S.settingsNoParsePath settings then unparsedPath else path !h = hashByteString rawPath @@ -83,6 +86,7 @@ $ Vault.insert getFileInfoKey (getFileInfo ii) $ Vault.insert getHTTP2DataKey (readIORef ref) $ Vault.insert setHTTP2DataKey (writeIORef ref) + $ Vault.insert modifyHTTP2DataKey (modifyIORef' ref) Vault.empty getHTTP2DataKey :: Vault.Key (IO (Maybe HTTP2Data)) @@ -103,10 +107,23 @@ {-# NOINLINE setHTTP2Data #-} -- | Setting 'HTTP2Data' through vault of the request. --- 'Middleware' should use this. +-- 'Application' or 'Middleware' should use this. -- -- Since: 3.2.7 setHTTP2Data :: Request -> Maybe HTTP2Data -> IO () setHTTP2Data req mh2d = case Vault.lookup setHTTP2DataKey (vault req) of Nothing -> return () Just setter -> setter mh2d + +modifyHTTP2DataKey :: Vault.Key ((Maybe HTTP2Data -> Maybe HTTP2Data) -> IO ()) +modifyHTTP2DataKey = unsafePerformIO Vault.newKey +{-# NOINLINE modifyHTTP2Data #-} + +-- | Modifying 'HTTP2Data' through vault of the request. +-- 'Application' or 'Middleware' should use this. +-- +-- Since: 3.2.8 +modifyHTTP2Data :: Request -> (Maybe HTTP2Data -> Maybe HTTP2Data) -> IO () +modifyHTTP2Data req func = case Vault.lookup modifyHTTP2DataKey (vault req) of + Nothing -> return () + Just modify -> modify func diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.2.7/Network/Wai/Handler/Warp/HTTP2/Sender.hs new/warp-3.2.8/Network/Wai/Handler/Warp/HTTP2/Sender.hs --- old/warp-3.2.7/Network/Wai/Handler/Warp/HTTP2/Sender.hs 2016-07-04 09:23:09.000000000 +0200 +++ new/warp-3.2.8/Network/Wai/Handler/Warp/HTTP2/Sender.hs 2016-08-04 07:01:44.000000000 +0200 @@ -18,7 +18,7 @@ import Data.Word (Word8, Word32) import Foreign.Ptr (Ptr, plusPtr) import Foreign.Storable (poke) -import Network.HPACK (setLimitForEncoding) +import Network.HPACK (setLimitForEncoding, toHeaderTable) import Network.HTTP2 import Network.HTTP2.Priority (isEmptySTM, dequeueSTM, Precedence) import Network.Wai @@ -122,16 +122,16 @@ Nothing -> return () Just siz -> setLimitForEncoding siz encodeDynamicTable - output (ONext strm curr mtbq tell) off0 lim = do + output out@(Output strm _ _ tell getH2D (ONext curr)) off0 lim = do -- Data frame payload let !buf = connWriteBuffer `plusPtr` off0 !siz = connBufferSize - off0 Next datPayloadLen mnext <- curr buf siz lim - off <- fillDataHeader strm off0 datPayloadLen mnext tell - maybeEnqueueNext strm mtbq mnext tell + off <- fillDataHeader strm off0 datPayloadLen mnext tell getH2D + maybeEnqueueNext out mnext return off - output (ORspn strm rspn ii tell) off0 lim = do + output out@(Output strm rspn ii tell getH2D ORspn) off0 lim = do -- Header frame and Continuation frame let !sid = streamNumber strm !endOfStream = case rspn of @@ -149,32 +149,32 @@ let payloadOff = off + frameHeaderLength Next datPayloadLen mnext <- fillFileBodyGetNext conn ii payloadOff lim path mpart - off' <- fillDataHeader strm off datPayloadLen mnext tell - maybeEnqueueNext strm Nothing mnext tell + off' <- fillDataHeader strm off datPayloadLen mnext tell getH2D + maybeEnqueueNext out mnext return off' RspnBuilder _ _ builder -> do -- Data frame payload let payloadOff = off + frameHeaderLength Next datPayloadLen mnext <- fillBuilderBodyGetNext conn ii payloadOff lim builder - off' <- fillDataHeader strm off datPayloadLen mnext tell - maybeEnqueueNext strm Nothing mnext tell + off' <- fillDataHeader strm off datPayloadLen mnext tell getH2D + maybeEnqueueNext out mnext return off' RspnStreaming _ _ tbq -> do let payloadOff = off + frameHeaderLength Next datPayloadLen mnext <- fillStreamBodyGetNext conn payloadOff lim tbq strm - off' <- fillDataHeader strm off datPayloadLen mnext tell - maybeEnqueueNext strm (Just tbq) mnext tell + off' <- fillDataHeader strm off datPayloadLen mnext tell getH2D + maybeEnqueueNext out mnext return off' - output (OPush strm ths rspn ii tell pid) off0 lim = do + output out@(Output strm _ _ _ _ (OPush ths pid)) off0 lim = do -- Creating a push promise header -- Frame id should be associated stream id from the client. let !sid = streamNumber strm len <- pushPromise pid sid ths off0 off <- sendHeadersIfNecessary $ off0 + frameHeaderLength + len - output (ORspn strm rspn ii tell) off lim + output out{ outputType = ORspn } off lim output _ _ _ = undefined -- never reach @@ -183,9 +183,12 @@ if isClosed state then return off else case out of - OWait strm' rsp ii wait -> do + Output _ _ _ wait _ OWait -> do -- Checking if all push are done. - let out' = ORspn strm' rsp ii (return ()) + let out' = out { + outputHook = return () + , outputType = ORspn + } forkAndEnqueueWhenReady wait outputQ out' mgr return off _ -> case mtbq of @@ -252,12 +255,11 @@ {-# INLINE maybeEnqueueNext #-} -- Re-enqueue the stream in the output queue. - maybeEnqueueNext :: Stream -> Maybe (TBQueue Sequence) - -> Maybe DynaNext -> IO () -> IO () - maybeEnqueueNext _ _ Nothing _ = return () - maybeEnqueueNext strm mtbq (Just next) tell = enqueueOutput outputQ out + maybeEnqueueNext :: Output -> Maybe DynaNext -> IO () + maybeEnqueueNext _ Nothing = return () + maybeEnqueueNext out (Just next) = enqueueOutput outputQ out' where - !out = ONext strm next mtbq tell + !out' = out { outputType = ONext next } {-# INLINE sendHeadersIfNecessary #-} -- Send headers if there is not room for a 1-byte data frame, and return @@ -269,21 +271,36 @@ flushN off return 0 - fillDataHeader strm off datPayloadLen mnext tell = do + fillDataHeader strm@Stream{streamWindow,streamNumber} + off datPayloadLen mnext tell getH2D = do -- Data frame header - let !sid = streamNumber strm + mh2d <- getH2D + let (!trailers,!noTrailers) = case http2dataTrailers <$> mh2d of + Nothing -> ([], True) + Just ts -> (ts, null ts) !buf = connWriteBuffer `plusPtr` off !off' = off + frameHeaderLength + datPayloadLen - !done = isNothing mnext - flag | done = setEndStream defaultFlags - | otherwise = defaultFlags - fillFrameHeader FrameData datPayloadLen sid flag buf - when done $ do + !noMoreBody = isNothing mnext + flag | noMoreBody && noTrailers = setEndStream defaultFlags + | otherwise = defaultFlags + fillFrameHeader FrameData datPayloadLen streamNumber flag buf + off'' <- handleEndOfBody noMoreBody off' noTrailers trailers + atomically $ modifyTVar' connectionWindow (subtract datPayloadLen) + atomically $ modifyTVar' streamWindow (subtract datPayloadLen) + return off'' + where + handleTrailers True off0 _ = return off0 + handleTrailers _ off0 trailers = do + (ths,_) <- toHeaderTable trailers + kvlen <- headerContinue streamNumber ths True off0 + sendHeadersIfNecessary $ off0 + frameHeaderLength + kvlen + handleEndOfBody True off0 noTrailers trailers = do + off1 <- handleTrailers noTrailers off0 trailers void $ tell closed ctx strm Finished - atomically $ modifyTVar' connectionWindow (subtract datPayloadLen) - atomically $ modifyTVar' (streamWindow strm) (subtract datPayloadLen) - return off' + return off1 + handleEndOfBody False off0 _ _ = return off0 + pushPromise pid sid ths off = do let !offsid = off + frameHeaderLength diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.2.7/Network/Wai/Handler/Warp/HTTP2/Types.hs new/warp-3.2.8/Network/Wai/Handler/Warp/HTTP2/Types.hs --- old/warp-3.2.7/Network/Wai/Handler/Warp/HTTP2/Types.hs 2016-07-04 09:23:09.000000000 +0200 +++ new/warp-3.2.8/Network/Wai/Handler/Warp/HTTP2/Types.hs 2016-08-04 07:01:44.000000000 +0200 @@ -68,27 +68,23 @@ rspnHeaders (RspnBuilder _ t _) = t rspnHeaders (RspnFile _ t _ _ ) = t -data Output = ORspn !Stream !Rspn !InternalInfo (IO ()) -- done - | OWait !Stream !Rspn !InternalInfo (IO ()) -- done - | OPush !Stream -- stream for this push from this server - TokenHeaderList - !Rspn {- RspnFile only-} - !InternalInfo (IO ()) -- wait for done - !StreamId -- associated stream id from client - | ONext !Stream !DynaNext !(Maybe (TBQueue Sequence)) (IO ()) -- done - -outputStream :: Output -> Stream -outputStream (ORspn strm _ _ _) = strm -outputStream (OPush strm _ _ _ _ _) = strm -outputStream (OWait strm _ _ _) = strm -outputStream (ONext strm _ _ _) = strm +data Output = Output { + outputStream :: !Stream + , outputRspn :: !Rspn + , outputII :: !InternalInfo + , outputHook :: IO () -- OPush: wait for done, O*: telling done + , outputH2Data :: IO (Maybe HTTP2Data) + , outputType :: !OutputType + } + +data OutputType = ORspn + | OWait + | OPush !TokenHeaderList !StreamId -- associated stream id from client + | ONext !DynaNext outputMaybeTBQueue :: Output -> Maybe (TBQueue Sequence) -outputMaybeTBQueue (ORspn _ (RspnStreaming _ _ tbq) _ _) = Just tbq -outputMaybeTBQueue (ORspn _ _ _ _) = Nothing -outputMaybeTBQueue (OPush _ _ _ _ _ _) = Nothing -outputMaybeTBQueue (OWait _ _ _ _) = Nothing -outputMaybeTBQueue (ONext _ _ mtbq _) = mtbq +outputMaybeTBQueue (Output _ (RspnStreaming _ _ tbq) _ _ _ _) = Just tbq +outputMaybeTBQueue _ = Nothing data Control = CFinish | CGoaway !ByteString @@ -286,18 +282,20 @@ -- | HTTP/2 specific data. -- -- Since: 3.2.7 -newtype HTTP2Data = HTTP2Data { +data HTTP2Data = HTTP2Data { -- | Accessor for 'PushPromise' in 'HTTP2Data'. -- -- Since: 3.2.7 http2dataPushPromise :: [PushPromise] + -- Since: 3.2.8 + , http2dataTrailers :: H.ResponseHeaders } deriving (Eq,Show) -- | Default HTTP/2 specific data. -- -- Since: 3.2.7 defaultHTTP2Data :: HTTP2Data -defaultHTTP2Data = HTTP2Data [] +defaultHTTP2Data = HTTP2Data [] [] -- | HTTP/2 push promise or sever push. -- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.2.7/Network/Wai/Handler/Warp/HTTP2/Worker.hs new/warp-3.2.8/Network/Wai/Handler/Warp/HTTP2/Worker.hs --- old/warp-3.2.7/Network/Wai/Handler/Warp/HTTP2/Worker.hs 2016-07-04 09:23:09.000000000 +0200 +++ new/warp-3.2.8/Network/Wai/Handler/Warp/HTTP2/Worker.hs 2016-08-04 07:01:44.000000000 +0200 @@ -57,7 +57,7 @@ pushStream :: Context -> S.Settings -> StreamId -> ValueTable -> Request -> InternalInfo -> Maybe HTTP2Data - -> IO (Stream -> Rspn -> InternalInfo -> IO () -> Output, IO ()) + -> IO (OutputType, IO ()) pushStream _ _ _ _ _ _ Nothing = return (ORspn, return ()) pushStream ctx@Context{http2settings,outputQ,streamTable} settings pid reqvt req ii (Just h2d) @@ -81,6 +81,7 @@ waiter lim tvar = atomically $ do n <- readTVar tvar check (n >= lim) + !h2data = getHTTP2Data req push _ [] !n = return (n :: Int) push tvar (pp:pps) !n = do let !file = promisedFile pp @@ -110,7 +111,8 @@ !ths = (tokenLastModified,date) : addContentHeadersForFilePart ths0 part pushLogger req path size - let out = OPush strm promisedRequest rsp ii (increment tvar) pid + let !ot = OPush promisedRequest pid + !out = Output strm rsp ii (increment tvar) h2data ot enqueueOutput outputQ out push tvar pps (n + 1) @@ -144,6 +146,7 @@ !logger = S.settingsLogger settings !th = threadHandle ii sid = streamNumber strm + !h2data = getHTTP2Data req -- Ideally, log messages should be written when responses are -- actually sent. But there is no way to keep good memory usage @@ -156,8 +159,8 @@ responseNoBody' s tbl = do logger req s Nothing setThreadContinue tconf True - let rspn = RspnNobody s tbl - out = ORspn strm rspn ii (return ()) + let !rspn = RspnNobody s tbl + !out = Output strm rspn ii (return ()) h2data ORspn enqueueOutput outputQ out return ResponseReceived @@ -165,8 +168,8 @@ logger req s Nothing setThreadContinue tconf True tbl <- toHeaderTable hs0 - let rspn = RspnBuilder s tbl bdy - out = rspnOrWait strm rspn ii tell + let !rspn = RspnBuilder s tbl bdy + !out = Output strm rspn ii tell h2data rspnOrWait enqueueOutput outputQ out return ResponseReceived @@ -191,8 +194,8 @@ | otherwise = do logger req s (filePartByteCount <$> mpart) setThreadContinue tconf True - let rspn = RspnFile s tbl path mpart - out = rspnOrWait strm rspn ii tell + let !rspn = RspnFile s tbl path mpart + !out = Output strm rspn ii tell h2data rspnOrWait enqueueOutput outputQ out return ResponseReceived @@ -217,8 +220,8 @@ -- So, let's serialize 'Builder' with a designated queue. tbq <- newTBQueueIO 10 -- fixme: hard coding: 10 tbl <- toHeaderTable hs0 - let rspn = RspnStreaming s0 tbl tbq - out = rspnOrWait strm rspn ii tell + let !rspn = RspnStreaming s0 tbl tbq + !out = Output strm rspn ii tell h2data rspnOrWait enqueueOutput outputQ out let push b = do atomically $ writeTBQueue tbq (SBuilder b) @@ -265,7 +268,7 @@ Nothing -> return () Just (Input strm req _reqvt _ii) -> do closed ctx strm Killed - let frame = resetFrame InternalError (streamNumber strm) + let !frame = resetFrame InternalError (streamNumber strm) enqueueControl controlQ $ CFrame frame case me of Nothing -> return () diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.2.7/Network/Wai/Handler/Warp.hs new/warp-3.2.8/Network/Wai/Handler/Warp.hs --- old/warp-3.2.7/Network/Wai/Handler/Warp.hs 2016-07-04 09:23:09.000000000 +0200 +++ new/warp-3.2.8/Network/Wai/Handler/Warp.hs 2016-08-04 07:01:44.000000000 +0200 @@ -104,9 +104,11 @@ -- ** HTTP2 data , HTTP2Data , http2dataPushPromise + , http2dataTrailers , defaultHTTP2Data , getHTTP2Data , setHTTP2Data + , modifyHTTP2Data -- ** Push promise , PushPromise , promisedPath @@ -129,7 +131,7 @@ import Network.Wai.Handler.Warp.Response (warpVersion) import Network.Wai.Handler.Warp.Run import Network.Wai.Handler.Warp.Settings -import Network.Wai.Handler.Warp.HTTP2.Request (getHTTP2Data, setHTTP2Data) +import Network.Wai.Handler.Warp.HTTP2.Request (getHTTP2Data, setHTTP2Data, modifyHTTP2Data) import Network.Wai.Handler.Warp.HTTP2.Types import Network.Wai.Handler.Warp.Timeout import Network.Wai.Handler.Warp.Types hiding (getFileInfo) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.2.7/test/inputFile new/warp-3.2.8/test/inputFile --- old/warp-3.2.7/test/inputFile 1970-01-01 01:00:00.000000000 +0100 +++ new/warp-3.2.8/test/inputFile 2016-08-04 07:01:44.000000000 +0200 @@ -0,0 +1,100 @@ +A acid +abacus major +abacus pythagoricus +A battery +abbey counter +abbey laird +abbey lands +abbey lubber +abbot cloth +Abbott papyrus +abb wool +A-b-c book +A-b-c method +abdomino-uterotomy +Abdul-baha +a-be +aberrant duct +aberration constant +abiding place +able-bodied +able-bodiedness +able-minded +able-mindedness +able seaman +aboli fruit +A bond +Abor-miri +a-borning +about-face +about ship +about-sledge +above-cited +above-found +above-given +above-mentioned +above-named +above-quoted +above-reported +above-said +above-water +above-written +Abraham-man +abraum salts +abraxas stone +Abri audit culture +abruptly acuminate +abruptly pinnate +absciss layer +absence state +absentee voting +absent-minded +absent-mindedly +absent-mindedness +absent treatment +absent voter +Absent voting +absinthe green +absinthe oil +absorption bands +absorption circuit +absorption coefficient +absorption current +absorption dynamometer +absorption factor +absorption lines +absorption pipette +absorption screen +absorption spectrum +absorption system +A b station +abstinence theory +abstract group +Abt system +abundance declaree +aburachan seed +abutment arch +abutment pier +abutting joint +acacia veld +academy blue +academy board +academy figure +acajou balsam +acanthosis nigricans +acanthus family +acanthus leaf +acaroid resin +Acca larentia +acceleration note +accelerator nerve +accent mark +acceptance bill +acceptance house +acceptance supra protest +acceptor supra protest +accession book +accession number +accession service +access road +accident insurance diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.2.7/warp.cabal new/warp-3.2.8/warp.cabal --- old/warp-3.2.7/warp.cabal 2016-07-04 09:23:09.000000000 +0200 +++ new/warp-3.2.8/warp.cabal 2016-08-04 07:01:44.000000000 +0200 @@ -1,5 +1,5 @@ Name: warp -Version: 3.2.7 +Version: 3.2.8 Synopsis: A fast, light-weight web server for WAI applications. License: MIT License-file: LICENSE @@ -19,6 +19,7 @@ ChangeLog.md README.md test/head-response + test/inputFile Flag network-bytestring Default: False
