Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-warp for openSUSE:Factory checked in at 2024-12-20 23:11:13 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-warp (Old) and /work/SRC/openSUSE:Factory/.ghc-warp.new.1881 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-warp" Fri Dec 20 23:11:13 2024 rev:19 rq:1231489 version:3.4.7 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-warp/ghc-warp.changes 2024-11-12 19:20:46.717852181 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-warp.new.1881/ghc-warp.changes 2024-12-20 23:12:08.040216642 +0100 @@ -1,0 +2,30 @@ +Tue Dec 3 06:33:00 UTC 2024 - Peter Simons <[email protected]> + +- Update warp to version 3.4.7. + ## 3.4.7 + + * Using time-manager >= 0.2. + + ## 3.4.6 + + * Using `withHandle` of time-manager. + +------------------------------------------------------------------- +Tue Nov 19 21:11:28 UTC 2024 - Peter Simons <[email protected]> + +- Update warp to version 3.4.5. + ## 3.4.5 + + * Rethrowing asynchronous exceptions and preventing callsing + `connClose` twice. + [#1013](https://github.com/yesodweb/wai/pull/1013) + +------------------------------------------------------------------- +Thu Nov 7 01:53:49 UTC 2024 - Peter Simons <[email protected]> + +- Update warp to version 3.4.4. + ## 3.4.4 + + * Removing `unliftio`. + +------------------------------------------------------------------- Old: ---- warp-3.4.3.tar.gz New: ---- warp-3.4.7.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-warp.spec ++++++ --- /var/tmp/diff_new_pack.g89PdR/_old 2024-12-20 23:12:08.656242046 +0100 +++ /var/tmp/diff_new_pack.g89PdR/_new 2024-12-20 23:12:08.656242046 +0100 @@ -20,7 +20,7 @@ %global pkgver %{pkg_name}-%{version} %bcond_with tests Name: ghc-%{pkg_name} -Version: 3.4.3 +Version: 3.4.7 Release: 0 Summary: A fast, light-weight web server for WAI applications License: MIT @@ -29,6 +29,8 @@ BuildRequires: ghc-Cabal-devel BuildRequires: ghc-array-devel BuildRequires: ghc-array-prof +BuildRequires: ghc-async-devel +BuildRequires: ghc-async-prof BuildRequires: ghc-auto-update-devel BuildRequires: ghc-auto-update-prof BuildRequires: ghc-base-devel @@ -70,8 +72,6 @@ BuildRequires: ghc-time-manager-prof BuildRequires: ghc-unix-devel BuildRequires: ghc-unix-prof -BuildRequires: ghc-unliftio-devel -BuildRequires: ghc-unliftio-prof BuildRequires: ghc-vault-devel BuildRequires: ghc-vault-prof BuildRequires: ghc-wai-devel ++++++ warp-3.4.3.tar.gz -> warp-3.4.7.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.4.3/ChangeLog.md new/warp-3.4.7/ChangeLog.md --- old/warp-3.4.3/ChangeLog.md 2001-09-09 03:46:40.000000000 +0200 +++ new/warp-3.4.7/ChangeLog.md 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,23 @@ # ChangeLog for warp +## 3.4.7 + +* Using time-manager >= 0.2. + +## 3.4.6 + +* Using `withHandle` of time-manager. + +## 3.4.5 + +* Rethrowing asynchronous exceptions and preventing callsing + `connClose` twice. + [#1013](https://github.com/yesodweb/wai/pull/1013) + +## 3.4.4 + +* Removing `unliftio`. + ## 3.4.3 * Waiting untill the number of FDs desreases on EMFILE. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.4.3/Network/Wai/Handler/Warp/Conduit.hs new/warp-3.4.7/Network/Wai/Handler/Warp/Conduit.hs --- old/warp-3.4.3/Network/Wai/Handler/Warp/Conduit.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/warp-3.4.7/Network/Wai/Handler/Warp/Conduit.hs 2001-09-09 03:46:40.000000000 +0200 @@ -2,10 +2,10 @@ module Network.Wai.Handler.Warp.Conduit where +import Control.Exception (assert, throwIO) import qualified Data.ByteString as S import qualified Data.IORef as I import Data.Word8 (_0, _9, _A, _F, _a, _cr, _f, _lf) -import UnliftIO (assert, throwIO) import Network.Wai.Handler.Warp.Imports import Network.Wai.Handler.Warp.Types diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.4.3/Network/Wai/Handler/Warp/Date.hs new/warp-3.4.7/Network/Wai/Handler/Warp/Date.hs --- old/warp-3.4.3/Network/Wai/Handler/Warp/Date.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/warp-3.4.7/Network/Wai/Handler/Warp/Date.hs 2001-09-09 03:46:40.000000000 +0200 @@ -5,7 +5,12 @@ GMTDate, ) where -import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate, updateAction) +import Control.AutoUpdate ( + defaultUpdateSettings, + mkAutoUpdate, + updateAction, + updateThreadName, + ) import Data.ByteString import Network.HTTP.Date @@ -29,6 +34,7 @@ mkAutoUpdate defaultUpdateSettings { updateAction = formatHTTPDate <$> getCurrentHTTPDate + , updateThreadName = "Date cacher (AutoUpdate)" } #ifdef WINDOWS diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.4.3/Network/Wai/Handler/Warp/FdCache.hs new/warp-3.4.7/Network/Wai/Handler/Warp/FdCache.hs --- old/warp-3.4.3/Network/Wai/Handler/Warp/FdCache.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/warp-3.4.7/Network/Wai/Handler/Warp/FdCache.hs 2001-09-09 03:46:40.000000000 +0200 @@ -26,7 +26,7 @@ openFd, setFdOption, ) -import UnliftIO.Exception (bracket) +import Control.Exception (bracket) #endif import System.Posix.Types (Fd) @@ -120,6 +120,7 @@ , reaperCons = uncurry insert , reaperNull = isEmpty , reaperEmpty = empty + , reaperThreadName = "Fd cacher (Reaper) " } clean :: FdCache -> IO (FdCache -> FdCache) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.4.3/Network/Wai/Handler/Warp/FileInfoCache.hs new/warp-3.4.7/Network/Wai/Handler/Warp/FileInfoCache.hs --- old/warp-3.4.3/Network/Wai/Handler/Warp/FileInfoCache.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/warp-3.4.7/Network/Wai/Handler/Warp/FileInfoCache.hs 2001-09-09 03:46:40.000000000 +0200 @@ -7,6 +7,7 @@ getInfo, -- test purpose only ) where +import Control.Exception (bracket, onException, throwIO) import Control.Reaper import Network.HTTP.Date #if WINDOWS @@ -14,7 +15,6 @@ #else import System.Posix.Files #endif -import qualified UnliftIO (bracket, onException, throwIO) import Network.Wai.Handler.Warp.HashMap (HashMap) import qualified Network.Wai.Handler.Warp.HashMap as M @@ -58,7 +58,7 @@ , fileInfoDate = date } return info - else UnliftIO.throwIO (userError "FileInfoCache:getInfo") + else throwIO (userError "FileInfoCache:getInfo") getInfoNaive :: FilePath -> IO FileInfo getInfoNaive = getInfo @@ -69,11 +69,11 @@ getAndRegisterInfo reaper path = do cache <- reaperRead reaper case M.lookup path cache of - Just Negative -> UnliftIO.throwIO (userError "FileInfoCache:getAndRegisterInfo") + Just Negative -> throwIO (userError "FileInfoCache:getAndRegisterInfo") Just (Positive x) -> return x Nothing -> positive reaper path - `UnliftIO.onException` negative reaper path + `onException` negative reaper path positive :: FileInfoCache -> FilePath -> IO FileInfo positive reaper path = do @@ -84,7 +84,7 @@ negative :: FileInfoCache -> FilePath -> IO FileInfo negative reaper path = do reaperAdd reaper (path, Negative) - UnliftIO.throwIO (userError "FileInfoCache:negative") + throwIO (userError "FileInfoCache:negative") ---------------------------------------------------------------- @@ -97,7 +97,7 @@ -> IO a withFileInfoCache 0 action = action getInfoNaive withFileInfoCache duration action = - UnliftIO.bracket + bracket (initialize duration) terminate (action . getAndRegisterInfo) @@ -112,6 +112,7 @@ , reaperCons = \(path, v) -> M.insert path v , reaperNull = M.isEmpty , reaperEmpty = M.empty + , reaperThreadName = "File info cacher (Reaper)" } override :: Cache -> IO (Cache -> Cache) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.4.3/Network/Wai/Handler/Warp/HTTP1.hs new/warp-3.4.7/Network/Wai/Handler/Warp/HTTP1.hs --- old/warp-3.4.3/Network/Wai/Handler/Warp/HTTP1.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/warp-3.4.7/Network/Wai/Handler/Warp/HTTP1.hs 2001-09-09 03:46:40.000000000 +0200 @@ -9,6 +9,7 @@ ) where import qualified Control.Concurrent as Conc (yield) +import Control.Exception (SomeException, catch, fromException, throwIO, try) import qualified Data.ByteString as BS import Data.Char (chr) import Data.IORef (IORef, newIORef, readIORef, writeIORef) @@ -17,8 +18,6 @@ import Network.Wai import Network.Wai.Internal (ResponseReceived (ResponseReceived)) import qualified System.TimeManager as T -import UnliftIO (SomeException, fromException, throwIO) -import qualified UnliftIO import "iproute" Data.IP (toHostAddress, toHostAddress6) import Network.Wai.Handler.Warp.Header @@ -115,7 +114,7 @@ -> Source -> IO () http1server settings ii conn transport app addr th istatus src = - loop FirstRequest `UnliftIO.catchAny` handler + loop FirstRequest `catch` handler where handler e -- See comment below referencing @@ -123,6 +122,7 @@ | Just NoKeepAliveRequest <- fromException e = return () -- No valid request | Just (BadFirstLine _) <- fromException e = return () + | isAsyncException e = throwIO e | otherwise = do _ <- sendErrorResponse @@ -151,7 +151,7 @@ mremainingRef idxhdr nextBodyFlush - `UnliftIO.catchAny` \e -> do + `catch` \e -> do settingsOnException settings (Just req) e -- Don't throw the error again to prevent calling settingsOnException twice. return CloseConnection @@ -166,8 +166,8 @@ -- and ignore. See: https://github.com/yesodweb/wai/issues/618 case keepAlive of - ReuseConnection -> loop SubsequentRequest - CloseConnection -> return () + ReuseConnection -> loop SubsequentRequest + CloseConnection -> return () data ReuseConnection = ReuseConnection | CloseConnection @@ -192,7 +192,7 @@ -- creating the request, we need to make sure that we don't get -- an async exception before calling the ResponseSource. keepAliveRef <- newIORef $ error "keepAliveRef not filled" - r <- UnliftIO.tryAny $ app req $ \res -> do + r <- try $ app req $ \res -> do T.resume th -- FIXME consider forcing evaluation of the res here to -- send more meaningful error messages to the user. @@ -205,6 +205,7 @@ Right ResponseReceived -> return () Left (e :: SomeException) | Just (ExceptionInsideResponseBody e') <- fromException e -> throwIO e' + | isAsyncException e -> throwIO e | otherwise -> do keepAlive <- sendErrorResponse settings ii conn th istatus req e settingsOnException settings (Just req) e @@ -226,27 +227,27 @@ then -- If there is an unknown or large amount of data to still be read -- from the request body, simple drop this connection instead of -- reading it all in to satisfy a keep-alive request. - case settingsMaximumBodyFlush settings of - Nothing -> do - flushEntireBody nextBodyFlush - T.resume th - return ReuseConnection - Just maxToRead -> do - let tryKeepAlive = do - -- flush the rest of the request body - isComplete <- flushBody nextBodyFlush maxToRead - if isComplete - then do - T.resume th - return ReuseConnection - else return CloseConnection - case mremainingRef of - Just ref -> do - remaining <- readIORef ref - if remaining <= maxToRead - then tryKeepAlive - else return CloseConnection - Nothing -> tryKeepAlive + case settingsMaximumBodyFlush settings of + Nothing -> do + flushEntireBody nextBodyFlush + T.resume th + return ReuseConnection + Just maxToRead -> do + let tryKeepAlive = do + -- flush the rest of the request body + isComplete <- flushBody nextBodyFlush maxToRead + if isComplete + then do + T.resume th + return ReuseConnection + else return CloseConnection + case mremainingRef of + Just ref -> do + remaining <- readIORef ref + if remaining <= maxToRead + then tryKeepAlive + else return CloseConnection + Nothing -> tryKeepAlive else return CloseConnection sendErrorResponse diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.4.3/Network/Wai/Handler/Warp/HTTP2/PushPromise.hs new/warp-3.4.7/Network/Wai/Handler/Warp/HTTP2/PushPromise.hs --- old/warp-3.4.3/Network/Wai/Handler/Warp/HTTP2/PushPromise.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/warp-3.4.7/Network/Wai/Handler/Warp/HTTP2/PushPromise.hs 2001-09-09 03:46:40.000000000 +0200 @@ -3,9 +3,9 @@ module Network.Wai.Handler.Warp.HTTP2.PushPromise where +import qualified Control.Exception as E import qualified Network.HTTP.Types as H import qualified Network.HTTP2.Server as H2 -import qualified UnliftIO import Network.Wai import Network.Wai.Handler.Warp.FileInfoCache @@ -22,9 +22,9 @@ fromPushPromise :: InternalInfo -> PushPromise -> IO (Maybe H2.PushPromise) fromPushPromise ii (PushPromise path file rsphdr w) = do - efinfo <- UnliftIO.tryIO $ getFileInfo ii file + efinfo <- E.try $ getFileInfo ii file case efinfo of - Left (_ex :: UnliftIO.IOException) -> return Nothing + Left (_ex :: E.IOException) -> return Nothing Right finfo -> do let !siz = fromIntegral $ fileInfoSize finfo !fileSpec = H2.FileSpec file 0 siz diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.4.3/Network/Wai/Handler/Warp/HTTP2/Response.hs new/warp-3.4.7/Network/Wai/Handler/Warp/HTTP2/Response.hs --- old/warp-3.4.3/Network/Wai/Handler/Warp/HTTP2/Response.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/warp-3.4.7/Network/Wai/Handler/Warp/HTTP2/Response.hs 2001-09-09 03:46:40.000000000 +0200 @@ -6,13 +6,13 @@ fromResponse, ) where +import qualified Control.Exception as E import qualified Data.ByteString.Builder as BB import qualified Data.List as L (find) import qualified Network.HTTP.Types as H import qualified Network.HTTP2.Server as H2 import Network.Wai hiding (responseBuilder, responseFile, responseStream) import Network.Wai.Internal (Response (..)) -import qualified UnliftIO import Network.Wai.Handler.Warp.File import Network.Wai.Handler.Warp.HTTP2.Request (getHTTP2Data) @@ -81,9 +81,9 @@ !bytes' = fromIntegral $ filePartByteCount fp !fileSpec = H2.FileSpec path off' bytes' responseFile _ rsphdr method path Nothing ii reqhdr = do - efinfo <- UnliftIO.tryIO $ getFileInfo ii path + efinfo <- E.try $ getFileInfo ii path case efinfo of - Left (_ex :: UnliftIO.IOException) -> return $ response404 rsphdr + Left (_ex :: E.IOException) -> return $ response404 rsphdr Right finfo -> do let reqidx = indexRequestHeader reqhdr rspidx = indexResponseHeader rsphdr diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.4.3/Network/Wai/Handler/Warp/HTTP2.hs new/warp-3.4.7/Network/Wai/Handler/Warp/HTTP2.hs --- old/warp-3.4.3/Network/Wai/Handler/Warp/HTTP2.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/warp-3.4.7/Network/Wai/Handler/Warp/HTTP2.hs 2001-09-09 03:46:40.000000000 +0200 @@ -9,9 +9,11 @@ http2server, ) where +import qualified Control.Exception as E import qualified Data.ByteString as BS import Data.IORef (readIORef) import qualified Data.IORef as I +import GHC.Conc.Sync (labelThread, myThreadId) import qualified Network.HTTP2.Frame as H2 import qualified Network.HTTP2.Server as H2 import Network.Socket (SockAddr) @@ -19,7 +21,6 @@ import Network.Wai import Network.Wai.Internal (ResponseReceived (..)) import qualified System.TimeManager as T -import qualified UnliftIO import Network.Wai.Handler.Warp.HTTP2.File import Network.Wai.Handler.Warp.HTTP2.PushPromise @@ -69,7 +70,7 @@ checkTLS setConnHTTP2 conn True H2.run H2.defaultServerConfig conf $ - http2server settings ii transport peersa app + http2server "Warp HTTP/2" settings ii transport peersa app where checkTLS = case transport of TCP -> return () -- direct @@ -80,16 +81,19 @@ -- -- Since 3.3.11 http2server - :: S.Settings + :: String + -> S.Settings -> InternalInfo -> Transport -> SockAddr -> Application -> H2.Server -http2server settings ii transport addr app h2req0 aux0 response = do +http2server label settings ii transport addr app h2req0 aux0 response = do + tid <- myThreadId + labelThread tid (label ++ " http2server " ++ show addr) req <- toWAIRequest h2req0 aux0 ref <- I.newIORef Nothing - eResponseReceived <- UnliftIO.tryAny $ app req $ \rsp -> do + eResponseReceived <- E.try $ app req $ \rsp -> do (h2rsp, st, hasBody) <- fromResponse settings ii req rsp pps <- if hasBody then fromPushPromises ii req else return [] I.writeIORef ref $ Just (h2rsp, pps, st) @@ -101,7 +105,9 @@ let msiz = fromIntegral <$> H2.responseBodySize h2rsp logResponse req st msiz mapM_ (logPushPromise req) pps - Left e -> do + Left e + | isAsyncException e -> E.throwIO e + | otherwise -> do S.settingsOnException settings (Just req) e let ersp = S.settingsOnExceptionResponse settings e st = responseStatus ersp @@ -131,7 +137,7 @@ wrappedRecvN :: T.Handle -> Int -> (BufSize -> IO ByteString) -> (BufSize -> IO ByteString) wrappedRecvN th slowlorisSize readN bufsize = do - bs <- UnliftIO.handleAny handler $ readN bufsize + bs <- E.handle handler $ readN bufsize -- TODO: think about the slowloris protection in HTTP2: current code -- might open a slow-loris attack vector. Rather than timing we should -- consider limiting the per-client connections assuming that in HTTP2 @@ -142,8 +148,8 @@ T.tickle th return bs where - handler :: UnliftIO.SomeException -> IO ByteString - handler _ = return "" + handler :: E.SomeException -> IO ByteString + handler = throughAsync (return "") -- connClose must not be called here since Run:fork calls it goaway :: Connection -> H2.ErrorCodeId -> ByteString -> IO () diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.4.3/Network/Wai/Handler/Warp/Imports.hs new/warp-3.4.7/Network/Wai/Handler/Warp/Imports.hs --- old/warp-3.4.3/Network/Wai/Handler/Warp/Imports.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/warp-3.4.7/Network/Wai/Handler/Warp/Imports.hs 2001-09-09 03:46:40.000000000 +0200 @@ -10,9 +10,12 @@ module Data.Word, module Data.Maybe, module Numeric, + throughAsync, + isAsyncException, ) where import Control.Applicative +import Control.Exception import Control.Monad import Data.Bits import Data.ByteString.Internal (ByteString (..)) @@ -23,3 +26,14 @@ import Data.Ord import Data.Word import Numeric + +isAsyncException :: Exception e => e -> Bool +isAsyncException e = + case fromException (toException e) of + Just (SomeAsyncException _) -> True + Nothing -> False + +throughAsync :: IO a -> SomeException -> IO a +throughAsync action (SomeException e) + | isAsyncException e = throwIO e + | otherwise = action diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.4.3/Network/Wai/Handler/Warp/Request.hs new/warp-3.4.7/Network/Wai/Handler/Warp/Request.hs --- old/warp-3.4.3/Network/Wai/Handler/Warp/Request.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/warp-3.4.7/Network/Wai/Handler/Warp/Request.hs 2001-09-09 03:46:40.000000000 +0200 @@ -27,7 +27,7 @@ #ifdef MIN_VERSION_crypton_x509 import Data.X509 #endif -import UnliftIO (Exception, throwIO) +import Control.Exception (Exception, throwIO) import qualified Network.HTTP.Types as H import Network.Socket (SockAddr) import Network.Wai diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.4.3/Network/Wai/Handler/Warp/RequestHeader.hs new/warp-3.4.7/Network/Wai/Handler/Warp/RequestHeader.hs --- old/warp-3.4.3/Network/Wai/Handler/Warp/RequestHeader.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/warp-3.4.7/Network/Wai/Handler/Warp/RequestHeader.hs 2001-09-09 03:46:40.000000000 +0200 @@ -13,7 +13,7 @@ import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr) import Foreign.Storable (peek) import qualified Network.HTTP.Types as H -import UnliftIO (throwIO) +import Control.Exception (throwIO) import Network.Wai.Handler.Warp.Imports import Network.Wai.Handler.Warp.Types diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.4.3/Network/Wai/Handler/Warp/Response.hs new/warp-3.4.7/Network/Wai/Handler/Warp/Response.hs --- old/warp-3.4.3/Network/Wai/Handler/Warp/Response.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/warp-3.4.7/Network/Wai/Handler/Warp/Response.hs 2001-09-09 03:46:40.000000000 +0200 @@ -14,6 +14,7 @@ addAltSvc, ) where +import qualified Control.Exception as E import Data.Array ((!)) import qualified Data.ByteString as S import Data.ByteString.Builder (Builder, byteString) @@ -38,7 +39,6 @@ import Network.Wai.Internal import qualified Paths_warp import qualified System.TimeManager as T -import qualified UnliftIO import Network.Wai.Handler.Warp.Buffer (toBuilderBuffer) import qualified Network.Wai.Handler.Warp.Date as D @@ -315,9 +315,9 @@ -- Simple WAI applications. -- Status is ignored sendRsp conn ii th ver _ hs0 rspidxhdr maxRspBufSize method (RspFile path Nothing reqidxhdr hook) = do - efinfo <- UnliftIO.tryIO $ getFileInfo ii path + efinfo <- E.try $ getFileInfo ii path case efinfo of - Left (_ex :: UnliftIO.IOException) -> + Left (_ex :: E.IOException) -> #ifdef WARP_DEBUG print _ex >> #endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.4.3/Network/Wai/Handler/Warp/Run.hs new/warp-3.4.7/Network/Wai/Handler/Warp/Run.hs --- old/warp-3.4.3/Network/Wai/Handler/Warp/Run.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/warp-3.4.7/Network/Wai/Handler/Warp/Run.hs 2001-09-09 03:46:40.000000000 +0200 @@ -9,12 +9,12 @@ module Network.Wai.Handler.Warp.Run where import Control.Arrow (first) -import Control.Exception (allowInterrupt) -import qualified Control.Exception +import qualified Control.Exception as E import qualified Data.ByteString as S import Data.IORef (newIORef, readIORef) import Data.Streaming.Network (bindPortTCP) import Foreign.C.Error (Errno (..), eCONNABORTED, eMFILE) +import GHC.Conc.Sync (labelThread, myThreadId) import GHC.IO.Exception (IOErrorType (..), IOException (..)) import Network.Socket ( SockAddr, @@ -38,8 +38,6 @@ import System.IO.Error (ioeGetErrorType) import qualified System.TimeManager as T import System.Timeout (timeout) -import UnliftIO (toException) -import qualified UnliftIO import Network.Wai.Handler.Warp.Buffer import Network.Wai.Handler.Warp.Counter @@ -83,7 +81,7 @@ else settingsGracefulCloseTimeout1 set if tm == 0 then close s - else gracefulClose s tm `UnliftIO.catchAny` \(UnliftIO.SomeException _) -> return () + else gracefulClose s tm `E.catch` throughAsync (return ()) #else , connClose = close s #endif @@ -94,12 +92,12 @@ , connMySockAddr = mysa } where - receive' sock pool = UnliftIO.handleIO handler $ receive sock pool + receive' sock pool = E.handle handler $ receive sock pool where - handler :: UnliftIO.IOException -> IO ByteString + handler :: E.IOException -> IO ByteString handler e | ioeGetErrorType e == InvalidArgument = return "" - | otherwise = UnliftIO.throwIO e + | otherwise = E.throwIO e sendfile writeBufferRef fid offset len hook headers = do writeBuffer <- readIORef writeBufferRef @@ -117,13 +115,13 @@ sendall = sendAll' s sendAll' sock bs = - UnliftIO.handleJust + E.handleJust ( \e -> if ioeGetErrorType e == ResourceVanished then Just ConnectionClosedByPeer else Nothing ) - UnliftIO.throwIO + E.throwIO $ Sock.sendAll sock bs -- | Run an 'Application' on the given port. @@ -153,7 +151,7 @@ runSettings :: Settings -> Application -> IO () runSettings set app = withSocketsDo $ - UnliftIO.bracket + E.bracket (bindPortTCP (settingsPort set) (settingsHost set)) close ( \socket -> do @@ -181,7 +179,7 @@ (s, sa) <- accept' socket setSocketCloseOnExec s -- NoDelay causes an error for AF_UNIX. - setSocketOption s NoDelay 1 `UnliftIO.catchAny` \(UnliftIO.SomeException _) -> return () + setSocketOption s NoDelay 1 `E.catch` throughAsync (return ()) conn <- socketConnection set s return (conn, sa) @@ -246,7 +244,7 @@ withTimeoutManager f = case settingsManager set of Just tm -> f tm Nothing -> - UnliftIO.bracket + E.bracket (T.initialize timeoutInSeconds) T.stopManager f @@ -277,7 +275,7 @@ -- acceptNewConnection and the registering of connClose. -- -- acceptLoop can be broken by closing the listening socket. - void $ UnliftIO.mask_ acceptLoop + void $ E.mask_ acceptLoop -- In some cases, we want to stop Warp here without graceful shutdown. -- So, async exceptions are allowed here. -- That's why `finally` is not used. @@ -285,7 +283,7 @@ where acceptLoop = do -- Allow async exceptions before receiving the next connection maker. - allowInterrupt + E.allowInterrupt -- acceptNewConnection will try to receive the next incoming -- request. It returns a /connection maker/, not a connection, @@ -302,7 +300,7 @@ acceptLoop acceptNewConnection = do - ex <- UnliftIO.tryIO getConnMaker + ex <- E.try getConnMaker case ex of Right x -> return $ Just x Left e -> do @@ -310,11 +308,11 @@ isErrno err = ioe_errno e == Just (getErrno err) if | isErrno eCONNABORTED -> acceptNewConnection | isErrno eMFILE -> do - settingsOnException set Nothing $ toException e + settingsOnException set Nothing $ E.toException e waitForDecreased counter acceptNewConnection | otherwise -> do - settingsOnException set Nothing $ toException e + settingsOnException set Nothing $ E.toException e return Nothing -- Fork a new worker thread for this connection maker, and ask for a @@ -327,7 +325,9 @@ -> Counter -> InternalInfo -> IO () -fork set mkConn addr app counter ii = settingsFork set $ \unmask -> +fork set mkConn addr app counter ii = settingsFork set $ \unmask -> do + tid <- myThreadId + labelThread tid "Warp just forked" -- Call the user-supplied on exception code if any -- exceptions are thrown. -- @@ -335,7 +335,7 @@ -- catch all exceptions and avoid them from propagating, even -- async exceptions. See: -- https://github.com/yesodweb/wai/issues/850 - Control.Exception.handle (settingsOnException set Nothing) $ + E.handle (settingsOnException set Nothing) $ -- Run the connection maker to get a new connection, and ensure -- that the connection is closed. If the mkConn call throws an -- exception, we will leak the connection. If the mkConn call is @@ -346,16 +346,16 @@ -- We grab the connection before registering timeouts since the -- timeouts will be useless during connection creation, due to the -- fact that async exceptions are still masked. - UnliftIO.bracket mkConn cleanUp (serve unmask) + E.bracket mkConn cleanUp (serve unmask) where cleanUp (conn, _) = - connClose conn `UnliftIO.finally` do + connClose conn `E.finally` do writeBuffer <- readIORef $ connWriteBuffer conn bufFree writeBuffer -- We need to register a timeout handler for this thread, and -- cancel that handler as soon as we exit. - serve unmask (conn, transport) = UnliftIO.bracket register cancel $ \th -> do + serve unmask (conn, transport) = T.withHandleKillThread (timeoutManager ii) (return ()) $ \th -> do -- We now have fully registered a connection close handler in -- the case of all exceptions, so it is safe to once again -- allow async exceptions. @@ -363,14 +363,11 @@ . -- Call the user-supplied code for connection open and -- close events - UnliftIO.bracket (onOpen addr) (onClose addr) + E.bracket (onOpen addr) (onClose addr) $ \goingon -> -- Actually serve this connection. bracket with closeConn -- above ensures the connection is closed. when goingon $ serveConnection conn ii th addr transport set app - where - register = T.registerKillThread (timeoutManager ii) (connClose conn) - cancel = T.cancel onOpen adr = increase counter >> settingsOnOpen set adr onClose adr _ = decrease counter >> settingsOnClose set adr @@ -386,6 +383,7 @@ -> IO () serveConnection conn ii th origAddr transport settings app = do -- fixme: Upgrading to HTTP/2 should be supported. + tid <- myThreadId (h2, bs) <- if isHTTP2 transport then return (True, "") @@ -396,8 +394,10 @@ else return (False, bs0) if settingsHTTP2Enabled settings && h2 then do + labelThread tid ("Warp HTTP/2 " ++ show origAddr) http2 settings ii conn transport app origAddr th bs else do + labelThread tid ("Warp HTTP/1.1 " ++ show origAddr) http1 settings ii conn transport app origAddr th bs where recv4 bs0 = do diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.4.3/Network/Wai/Handler/Warp/SendFile.hs new/warp-3.4.7/Network/Wai/Handler/Warp/SendFile.hs --- old/warp-3.4.3/Network/Wai/Handler/Warp/SendFile.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/warp-3.4.7/Network/Wai/Handler/Warp/SendFile.hs 2001-09-09 03:46:40.000000000 +0200 @@ -19,13 +19,13 @@ import Foreign.Ptr (plusPtr) import qualified System.IO as IO #else +import qualified Control.Exception as E import Foreign.C.Error (throwErrno) import Foreign.C.Types import Foreign.Ptr (Ptr, castPtr, plusPtr) import Network.Sendfile import Network.Wai.Handler.Warp.FdCache (openFile, closeFile) import System.Posix.Types -import qualified UnliftIO #endif import Network.Wai.Handler.Warp.Buffer @@ -118,7 +118,7 @@ #else readSendFile :: Buffer -> BufSize -> (ByteString -> IO ()) -> SendFile readSendFile buf siz send fid off0 len0 hook headers = - UnliftIO.bracket setup teardown $ \fd -> do + E.bracket setup teardown $ \fd -> do hn <- packHeader buf siz send hook headers 0 let room = siz - hn buf' = buf `plusPtr` hn diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.4.3/Network/Wai/Handler/Warp/Settings.hs new/warp-3.4.7/Network/Wai/Handler/Warp/Settings.hs --- old/warp-3.4.3/Network/Wai/Handler/Warp/Settings.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/warp-3.4.7/Network/Wai/Handler/Warp/Settings.hs 2001-09-09 03:46:40.000000000 +0200 @@ -9,6 +9,7 @@ module Network.Wai.Handler.Warp.Settings where +import Control.Exception (SomeException(..), fromException, throw) import qualified Data.ByteString.Builder as Builder import qualified Data.ByteString.Char8 as C8 import Data.Streaming.Network (HostPreference) @@ -16,7 +17,7 @@ import qualified Data.Text.IO as TIO import Data.Version (showVersion) import GHC.IO (IO (IO), unsafeUnmask) -import GHC.IO.Exception (AsyncException (ThreadKilled), IOErrorType (..)) +import GHC.IO.Exception (IOErrorType (..)) import GHC.Prim (fork#) import qualified Network.HTTP.Types as H import Network.Socket (SockAddr, Socket, accept) @@ -25,7 +26,6 @@ import System.IO (stderr) import System.IO.Error (ioeGetErrorType) import System.TimeManager -import UnliftIO (SomeException, fromException) import Network.Wai.Handler.Warp.Imports import Network.Wai.Handler.Warp.Types @@ -228,12 +228,11 @@ -- Since 2.1.3 defaultShouldDisplayException :: SomeException -> Bool defaultShouldDisplayException se - | Just ThreadKilled <- fromException se = False | Just (_ :: InvalidRequest) <- fromException se = False | Just (ioeGetErrorType -> et) <- fromException se , et == ResourceVanished || et == InvalidArgument = False - | Just TimeoutThread <- fromException se = False + | isAsyncException se = False | otherwise = True -- | Printing an exception to standard error @@ -255,6 +254,7 @@ -- Since 3.2.27 defaultOnExceptionResponse :: SomeException -> Response defaultOnExceptionResponse e + | isAsyncException e = throw e | Just PayloadTooLarge <- fromException e = responseLBS H.status413 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.4.3/Network/Wai/Handler/Warp/Types.hs new/warp-3.4.7/Network/Wai/Handler/Warp/Types.hs --- old/warp-3.4.3/Network/Wai/Handler/Warp/Types.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/warp-3.4.7/Network/Wai/Handler/Warp/Types.hs 2001-09-09 03:46:40.000000000 +0200 @@ -7,7 +7,7 @@ import qualified Data.ByteString as S import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Typeable (Typeable) -import qualified UnliftIO +import qualified Control.Exception as E #ifdef MIN_VERSION_crypton_x509 import Data.X509 #endif @@ -60,7 +60,7 @@ show RequestHeaderFieldsTooLarge = "Request header fields too large" show PayloadTooLarge = "Payload too large" -instance UnliftIO.Exception InvalidRequest +instance E.Exception InvalidRequest ---------------------------------------------------------------- @@ -70,10 +70,10 @@ -- -- Used to determine whether keeping the HTTP1.1 connection / HTTP2 stream alive is safe -- or irrecoverable. -newtype ExceptionInsideResponseBody = ExceptionInsideResponseBody UnliftIO.SomeException +newtype ExceptionInsideResponseBody = ExceptionInsideResponseBody E.SomeException deriving (Show, Typeable) -instance UnliftIO.Exception ExceptionInsideResponseBody +instance E.Exception ExceptionInsideResponseBody ---------------------------------------------------------------- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.4.3/Network/Wai/Handler/Warp/WithApplication.hs new/warp-3.4.7/Network/Wai/Handler/Warp/WithApplication.hs --- old/warp-3.4.3/Network/Wai/Handler/Warp/WithApplication.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/warp-3.4.7/Network/Wai/Handler/Warp/WithApplication.hs 2001-09-09 03:46:40.000000000 +0200 @@ -10,6 +10,8 @@ ) where import Control.Concurrent +import Control.Concurrent.Async +import qualified Control.Exception as E import Control.Monad (when) import Data.Streaming.Network (bindRandomPortTCP) import Network.Socket @@ -17,8 +19,6 @@ import Network.Wai.Handler.Warp.Run import Network.Wai.Handler.Warp.Settings import Network.Wai.Handler.Warp.Types -import qualified UnliftIO -import UnliftIO.Async -- | Runs the given 'Application' on a free port. Passes the port to the given -- operation and executes it, while the 'Application' is running. Shuts down the @@ -47,7 +47,7 @@ (runSettingsSocket settings sock app) (waitFor started >> action port) case result of - Left () -> UnliftIO.throwString "Unexpected: runSettingsSocket exited" + Left () -> E.throwIO $ E.ErrorCall "Unexpected: runSettingsSocket exited" Right x -> return x -- | Same as 'withApplication' but with different exception handling: If the @@ -75,11 +75,11 @@ callingThread <- myThreadId app <- mkApp let wrappedApp request respond = - app request respond `UnliftIO.catchAny` \e -> do + app request respond `E.catch` \e -> do when (defaultShouldDisplayException e) (throwTo callingThread e) - UnliftIO.throwIO e + E.throwIO e withApplicationSettings settings (return wrappedApp) action data Waiter a = Waiter @@ -104,4 +104,4 @@ -- | Like 'openFreePort' but closes the socket before exiting. withFreePort :: ((Port, Socket) -> IO a) -> IO a -withFreePort = UnliftIO.bracket openFreePort (close . snd) +withFreePort = E.bracket openFreePort (close . snd) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.4.3/Network/Wai/Handler/Warp.hs new/warp-3.4.7/Network/Wai/Handler/Warp.hs --- old/warp-3.4.3/Network/Wai/Handler/Warp.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/warp-3.4.7/Network/Wai/Handler/Warp.hs 2001-09-09 03:46:40.000000000 +0200 @@ -141,7 +141,7 @@ import Data.Streaming.Network (HostPreference) import qualified Data.Vault.Lazy as Vault -import UnliftIO.Exception (SomeException, throwIO) +import Control.Exception (SomeException, throwIO) #ifdef MIN_VERSION_crypton_x509 import Data.X509 #endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.4.3/bench/Parser.hs new/warp-3.4.7/bench/Parser.hs --- old/warp-3.4.3/bench/Parser.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/warp-3.4.7/bench/Parser.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,10 +1,10 @@ {-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Main where +import Control.Exception (throw, throwIO) import Control.Monad import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as B (pack, unpack) @@ -16,17 +16,12 @@ import Foreign.Ptr import Foreign.Storable import qualified Network.HTTP.Types as H -import UnliftIO.Exception (impureThrow, throwIO) import Prelude hiding (lines) import Network.Wai.Handler.Warp.Request (FirstRequest (..), headerLines) import Network.Wai.Handler.Warp.Types -#if MIN_VERSION_gauge(0, 2, 0) -import Gauge -#else -import Gauge.Main -#endif +import Criterion.Main -- $setup -- >>> :set -XOverloadedStrings @@ -86,15 +81,15 @@ where (!method, !rest) = S.break (== _space) requestLine (!pathQuery, !httpVer') - | rest == "" = impureThrow badmsg + | rest == "" = throw badmsg | otherwise = S.break (== _space) (S.drop 1 rest) (!path, !query) = S.break (== _question) pathQuery !httpVer = S.drop 1 httpVer' (!http, !ver) - | httpVer == "" = impureThrow badmsg + | httpVer == "" = throw badmsg | otherwise = S.break (== _slash) httpVer !hv - | http /= "HTTP" = impureThrow NonHttp + | http /= "HTTP" = throw NonHttp | ver == "/1.1" = H.http11 | otherwise = H.http10 !ret = (method, path, query, hv) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.4.3/test/ExceptionSpec.hs new/warp-3.4.7/test/ExceptionSpec.hs --- old/warp-3.4.3/test/ExceptionSpec.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/warp-3.4.7/test/ExceptionSpec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -6,6 +6,8 @@ #if __GLASGOW_HASKELL__ < 709 import Control.Applicative #endif +import Control.Concurrent.Async (withAsync) +import Control.Exception import Control.Monad import qualified Data.Streaming.Network as N import Network.HTTP.Types hiding (Header) @@ -14,8 +16,6 @@ import Network.Wai.Handler.Warp import Network.Wai.Internal (Request (..)) import Test.Hspec -import UnliftIO.Async (withAsync) -import UnliftIO.Exception import HTTP diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.4.3/test/RunSpec.hs new/warp-3.4.7/test/RunSpec.hs --- old/warp-3.4.3/test/RunSpec.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/warp-3.4.7/test/RunSpec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -23,8 +23,8 @@ import System.IO.Unsafe (unsafePerformIO) import System.Timeout (timeout) import Test.Hspec -import UnliftIO.Exception (IOException, bracket, onException, try) -import qualified UnliftIO.Exception as E +import Control.Exception (IOException, bracket, onException, try) +import qualified Control.Exception as E import HTTP diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.4.3/test/SendFileSpec.hs new/warp-3.4.7/test/SendFileSpec.hs --- old/warp-3.4.3/test/SendFileSpec.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/warp-3.4.7/test/SendFileSpec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -13,7 +13,7 @@ import qualified System.IO as IO import System.Process (system) import Test.Hspec -import UnliftIO.Exception +import Control.Exception main :: IO () main = hspec spec diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.4.3/test/WithApplicationSpec.hs new/warp-3.4.7/test/WithApplicationSpec.hs --- old/warp-3.4.3/test/WithApplicationSpec.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/warp-3.4.7/test/WithApplicationSpec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -2,12 +2,12 @@ module WithApplicationSpec where +import Control.Exception import Network.HTTP.Types import Network.Wai import System.Environment import System.Process import Test.Hspec -import UnliftIO.Exception import Network.Wai.Handler.Warp.WithApplication @@ -30,17 +30,17 @@ output `shouldBe` "foo" it "does not propagate exceptions from the server to the executing thread" $ do - let mkApp = return $ \_request _respond -> throwString "foo" + let mkApp = return $ \_request _respond -> throwIO $ ErrorCall "foo" withApplication mkApp $ \port -> do output <- readProcess "curl" ["-s", "localhost:" ++ show port] "" output `shouldContain` "Something went wron" describe "testWithApplication" $ do it "propagates exceptions from the server to the executing thread" $ do - let mkApp = return $ \_request _respond -> throwString "foo" + let mkApp = return $ \_request _respond -> throwIO $ ErrorCall "foo" testWithApplication mkApp ( \port -> do readProcess "curl" ["-s", "localhost:" ++ show port] "" ) - `shouldThrow` (\(StringException str _) -> str == "foo") + `shouldThrow` (errorCall "foo") diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.4.3/warp.cabal new/warp-3.4.7/warp.cabal --- old/warp-3.4.3/warp.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/warp-3.4.7/warp.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: warp -version: 3.4.3 +version: 3.4.7 license: MIT license-file: LICENSE maintainer: [email protected] @@ -85,7 +85,8 @@ build-depends: base >=4.12 && <5, array, - auto-update >=0.2 && <0.3, + auto-update >=0.2.2 && <0.3, + async, bsb-http-chunked <0.1, bytestring >=0.9.1.4, case-insensitive >=0.2, @@ -101,11 +102,10 @@ stm >=2.3, streaming-commons >=0.1.10, text, - time-manager >=0.1 && <0.2, + time-manager >=0.2 && <0.3, vault >=0.3, wai >=3.2.4 && <3.3, - word8, - unliftio + word8 if flag(x509) build-depends: crypton-x509 @@ -217,6 +217,7 @@ QuickCheck, array, auto-update, + async, bsb-http-chunked <0.1, bytestring >=0.9.1.4, case-insensitive >=0.2, @@ -240,8 +241,7 @@ time-manager, vault, wai >=3.2.2.1 && <3.3, - word8, - unliftio + word8 if flag(x509) build-depends: crypton-x509 @@ -295,7 +295,7 @@ bytestring, case-insensitive, containers, - gauge, + criterion, ghc-prim, hashable, http-date, @@ -306,7 +306,6 @@ streaming-commons, text, time-manager, - unliftio, vault, wai, word8
