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 2021-06-01 10:39:11 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-warp (Old) and /work/SRC/openSUSE:Factory/.ghc-warp.new.1898 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-warp" Tue Jun 1 10:39:11 2021 rev:7 rq:896221 version:3.3.16 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-warp/ghc-warp.changes 2021-04-26 16:40:36.338172261 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-warp.new.1898/ghc-warp.changes 2021-06-01 10:40:49.077155886 +0200 @@ -1,0 +2,10 @@ +Wed May 26 08:45:34 UTC 2021 - [email protected] + +- Update warp to version 3.3.16. + # ChangeLog for warp + + ## 3.3.16 + + * Move exception handling over to `unliftio` for better async exception support [#845](https://github.com/yesodweb/wai/issues/845) + +------------------------------------------------------------------- Old: ---- warp-3.3.15.tar.gz New: ---- warp-3.3.16.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-warp.spec ++++++ --- /var/tmp/diff_new_pack.CR9t0F/_old 2021-06-01 10:40:49.481156574 +0200 +++ /var/tmp/diff_new_pack.CR9t0F/_new 2021-06-01 10:40:49.485156581 +0200 @@ -19,7 +19,7 @@ %global pkg_name warp %bcond_with tests Name: ghc-%{pkg_name} -Version: 3.3.15 +Version: 3.3.16 Release: 0 Summary: A fast, light-weight web server for WAI applications License: MIT @@ -27,7 +27,6 @@ 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-auto-update-devel BuildRequires: ghc-bsb-http-chunked-devel BuildRequires: ghc-bytestring-devel @@ -47,6 +46,7 @@ BuildRequires: ghc-time-manager-devel BuildRequires: ghc-unix-compat-devel BuildRequires: ghc-unix-devel +BuildRequires: ghc-unliftio-devel BuildRequires: ghc-vault-devel BuildRequires: ghc-wai-devel BuildRequires: ghc-word8-devel @@ -55,10 +55,10 @@ %if %{with tests} BuildRequires: ghc-HUnit-devel BuildRequires: ghc-QuickCheck-devel +BuildRequires: ghc-async-devel BuildRequires: ghc-directory-devel BuildRequires: ghc-hspec-devel BuildRequires: ghc-http-client-devel -BuildRequires: ghc-lifted-base-devel BuildRequires: ghc-process-devel BuildRequires: ghc-time-devel %endif ++++++ warp-3.3.15.tar.gz -> warp-3.3.16.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.3.15/ChangeLog.md new/warp-3.3.16/ChangeLog.md --- old/warp-3.3.15/ChangeLog.md 2021-04-16 06:44:27.000000000 +0200 +++ new/warp-3.3.16/ChangeLog.md 2021-05-26 07:02:00.000000000 +0200 @@ -1,3 +1,9 @@ +# ChangeLog for warp + +## 3.3.16 + +* Move exception handling over to `unliftio` for better async exception support [#845](https://github.com/yesodweb/wai/issues/845) + ## 3.3.15 * Using http2 v3. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.3.15/Network/Wai/Handler/Warp/Conduit.hs new/warp-3.3.16/Network/Wai/Handler/Warp/Conduit.hs --- old/warp-3.3.15/Network/Wai/Handler/Warp/Conduit.hs 2021-04-16 06:44:27.000000000 +0200 +++ new/warp-3.3.16/Network/Wai/Handler/Warp/Conduit.hs 2021-05-26 07:02:00.000000000 +0200 @@ -2,7 +2,7 @@ module Network.Wai.Handler.Warp.Conduit where -import Control.Exception +import UnliftIO (assert, throwIO) import qualified Data.ByteString as S import qualified Data.IORef as I diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.3.15/Network/Wai/Handler/Warp/FdCache.hs new/warp-3.3.16/Network/Wai/Handler/Warp/FdCache.hs --- old/warp-3.3.15/Network/Wai/Handler/Warp/FdCache.hs 2021-04-16 06:44:27.000000000 +0200 +++ new/warp-3.3.16/Network/Wai/Handler/Warp/FdCache.hs 2021-05-26 07:02:00.000000000 +0200 @@ -14,7 +14,7 @@ ) where #ifndef WINDOWS -import Control.Exception (bracket) +import UnliftIO.Exception (bracket) import Control.Reaper import Data.IORef import Network.Wai.Handler.Warp.MultiMap as MM diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.3.15/Network/Wai/Handler/Warp/FileInfoCache.hs new/warp-3.3.16/Network/Wai/Handler/Warp/FileInfoCache.hs --- old/warp-3.3.15/Network/Wai/Handler/Warp/FileInfoCache.hs 2021-04-16 06:44:27.000000000 +0200 +++ new/warp-3.3.16/Network/Wai/Handler/Warp/FileInfoCache.hs 2021-05-26 07:02:00.000000000 +0200 @@ -6,7 +6,7 @@ , getInfo -- test purpose only ) where -import Control.Exception as E +import qualified UnliftIO (onException, bracket, throwIO) import Control.Reaper import Network.HTTP.Date import System.PosixCompat.Files @@ -49,7 +49,7 @@ } return info else - throwIO (userError "FileInfoCache:getInfo") + UnliftIO.throwIO (userError "FileInfoCache:getInfo") getInfoNaive :: FilePath -> IO FileInfo getInfoNaive = getInfo @@ -60,10 +60,10 @@ getAndRegisterInfo reaper@Reaper{..} path = do cache <- reaperRead case M.lookup path cache of - Just Negative -> throwIO (userError "FileInfoCache:getAndRegisterInfo") + Just Negative -> UnliftIO.throwIO (userError "FileInfoCache:getAndRegisterInfo") Just (Positive x) -> return x Nothing -> positive reaper path - `E.onException` negative reaper path + `UnliftIO.onException` negative reaper path positive :: FileInfoCache -> FilePath -> IO FileInfo positive Reaper{..} path = do @@ -74,7 +74,7 @@ negative :: FileInfoCache -> FilePath -> IO FileInfo negative Reaper{..} path = do reaperAdd (path, Negative) - throwIO (userError "FileInfoCache:negative") + UnliftIO.throwIO (userError "FileInfoCache:negative") ---------------------------------------------------------------- @@ -86,9 +86,10 @@ -> IO a withFileInfoCache 0 action = action getInfoNaive withFileInfoCache duration action = - E.bracket (initialize duration) - terminate - (action . getAndRegisterInfo) + UnliftIO.bracket + (initialize duration) + terminate + (action . getAndRegisterInfo) initialize :: Int -> IO FileInfoCache initialize duration = mkReaper settings diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.3.15/Network/Wai/Handler/Warp/HTTP1.hs new/warp-3.3.16/Network/Wai/Handler/Warp/HTTP1.hs --- old/warp-3.3.15/Network/Wai/Handler/Warp/HTTP1.hs 2021-04-16 06:44:27.000000000 +0200 +++ new/warp-3.3.16/Network/Wai/Handler/Warp/HTTP1.hs 2021-05-26 07:02:00.000000000 +0200 @@ -10,7 +10,8 @@ import "iproute" Data.IP (toHostAddress, toHostAddress6) import qualified Control.Concurrent as Conc (yield) -import Control.Exception as E +import qualified UnliftIO +import UnliftIO (SomeException, fromException, throwIO) import qualified Data.ByteString as BS import Data.Char (chr) import Data.IORef (IORef, newIORef, readIORef, writeIORef) @@ -84,7 +85,7 @@ http1server :: Settings -> InternalInfo -> Connection -> Transport -> Application -> SockAddr -> T.Handle -> IORef Bool -> Source -> IO () http1server settings ii conn transport app addr th istatus src = - loop True `E.catch` handler + loop True `UnliftIO.catchAny` handler where handler e -- See comment below referencing @@ -99,7 +100,7 @@ loop firstRequest = do (req, mremainingRef, idxhdr, nextBodyFlush) <- recvRequest firstRequest settings conn ii th addr src transport keepAlive <- processRequest settings ii conn app th istatus src req mremainingRef idxhdr nextBodyFlush - `E.catch` \e -> do + `UnliftIO.catchAny` \e -> do settingsOnException settings (Just req) e -- Don't throw the error again to prevent calling settingsOnException twice. return False @@ -124,7 +125,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 <- E.try $ app req $ \res -> do + r <- UnliftIO.tryAny $ app req $ \res -> do T.resume th -- FIXME consider forcing evaluation of the res here to -- send more meaningful error messages to the user. @@ -135,7 +136,7 @@ return ResponseReceived case r of Right ResponseReceived -> return () - Left e@(SomeException _) + Left (e :: SomeException) | Just (ExceptionInsideResponseBody e') <- fromException e -> throwIO e' | otherwise -> do keepAlive <- sendErrorResponse settings ii conn th istatus req e diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.3.15/Network/Wai/Handler/Warp/HTTP2/PushPromise.hs new/warp-3.3.16/Network/Wai/Handler/Warp/HTTP2/PushPromise.hs --- old/warp-3.3.15/Network/Wai/Handler/Warp/HTTP2/PushPromise.hs 2021-04-16 06:44:27.000000000 +0200 +++ new/warp-3.3.16/Network/Wai/Handler/Warp/HTTP2/PushPromise.hs 2021-05-26 07:02:00.000000000 +0200 @@ -4,7 +4,7 @@ module Network.Wai.Handler.Warp.HTTP2.PushPromise where -import qualified Control.Exception as E +import qualified UnliftIO import qualified Network.HTTP.Types as H import qualified Network.HTTP2.Server as H2 @@ -25,9 +25,9 @@ fromPushPromise :: InternalInfo -> PushPromise -> IO (Maybe H2.PushPromise) fromPushPromise ii (PushPromise path file rsphdr w) = do - efinfo <- E.try $ getFileInfo ii file + efinfo <- UnliftIO.tryIO $ getFileInfo ii file case efinfo of - Left (_ex :: E.IOException) -> return Nothing + Left (_ex :: UnliftIO.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.3.15/Network/Wai/Handler/Warp/HTTP2/Response.hs new/warp-3.3.16/Network/Wai/Handler/Warp/HTTP2/Response.hs --- old/warp-3.3.15/Network/Wai/Handler/Warp/HTTP2/Response.hs 2021-04-16 06:44:27.000000000 +0200 +++ new/warp-3.3.16/Network/Wai/Handler/Warp/HTTP2/Response.hs 2021-05-26 07:02:00.000000000 +0200 @@ -7,7 +7,7 @@ fromResponse ) where -import qualified Control.Exception as E +import qualified UnliftIO import qualified Data.ByteString.Builder as BB import qualified Network.HTTP.Types as H import qualified Network.HTTP2.Server as H2 @@ -69,9 +69,9 @@ !fileSpec = H2.FileSpec path off' bytes' responseFile _ rsphdr isHead path Nothing ii reqhdr = do - efinfo <- E.try $ getFileInfo ii path + efinfo <- UnliftIO.tryIO $ getFileInfo ii path case efinfo of - Left (_ex :: E.IOException) -> return $ response404 rsphdr + Left (_ex :: UnliftIO.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.3.15/Network/Wai/Handler/Warp/HTTP2.hs new/warp-3.3.16/Network/Wai/Handler/Warp/HTTP2.hs --- old/warp-3.3.15/Network/Wai/Handler/Warp/HTTP2.hs 2021-04-16 06:44:27.000000000 +0200 +++ new/warp-3.3.16/Network/Wai/Handler/Warp/HTTP2.hs 2021-05-26 07:02:00.000000000 +0200 @@ -9,7 +9,7 @@ , http2server ) where -import qualified Control.Exception as E +import qualified UnliftIO import qualified Data.ByteString as BS import Data.IORef (IORef, newIORef, writeIORef) import qualified Data.IORef as I @@ -73,7 +73,7 @@ http2server settings ii transport addr app h2req0 aux0 response = do req <- toWAIRequest h2req0 aux0 ref <- I.newIORef Nothing - eResponseReceived <- E.try $ app req $ \rsp -> do + eResponseReceived <- UnliftIO.tryAny $ 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) @@ -85,12 +85,7 @@ let msiz = fromIntegral <$> H2.responseBodySize h2rsp logResponse req st msiz mapM_ (logPushPromise req) pps - Left e@(E.SomeException _) - -- killed by the local worker manager - | Just E.ThreadKilled <- E.fromException e -> return () - -- killed by the local timeout manager - | Just T.TimeoutThread <- E.fromException e -> return () - | otherwise -> do + Left e -> do S.settingsOnException settings (Just req) e let ersp = S.settingsOnExceptionResponse settings e st = responseStatus ersp diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.3.15/Network/Wai/Handler/Warp/Recv.hs new/warp-3.3.16/Network/Wai/Handler/Warp/Recv.hs --- old/warp-3.3.15/Network/Wai/Handler/Warp/Recv.hs 2021-04-16 06:44:27.000000000 +0200 +++ new/warp-3.3.16/Network/Wai/Handler/Warp/Recv.hs 2021-05-26 07:02:00.000000000 +0200 @@ -9,7 +9,7 @@ , spell ) where -import qualified Control.Exception as E +import qualified UnliftIO import qualified Data.ByteString as BS import Data.IORef import Foreign.C.Error (eAGAIN, getErrno, throwErrno) @@ -55,13 +55,13 @@ return $ receiveN ref (receive s pool) (receiveBuf s) receiveN :: IORef ByteString -> Recv -> RecvBuf -> BufSize -> IO ByteString -receiveN ref recv recvBuf size = E.handle handler $ do +receiveN ref recv recvBuf size = UnliftIO.handleAny handler $ do cached <- readIORef ref (bs, leftover) <- spell cached size recv recvBuf writeIORef ref leftover return bs where - handler :: E.SomeException -> IO ByteString + handler :: UnliftIO.SomeException -> IO ByteString handler _ = return "" ---------------------------------------------------------------- @@ -100,7 +100,7 @@ -- In that case, an error of "Bad file descriptor" occurs. -- We ignores it because we expect TimeoutThread. receive :: Socket -> BufferPool -> Recv -receive sock pool = E.handle handler $ withBufferPool pool $ \ (ptr, size) -> do +receive sock pool = UnliftIO.handleIO handler $ withBufferPool pool $ \ (ptr, size) -> do #if MIN_VERSION_network(3,1,0) withFdSocket sock $ \fd -> do #elif MIN_VERSION_network(3,0,0) @@ -111,10 +111,10 @@ let size' = fromIntegral size fromIntegral <$> receiveloop fd ptr size' where - handler :: E.IOException -> IO ByteString + handler :: UnliftIO.IOException -> IO ByteString handler e | E.ioeGetErrorType e == E.InvalidArgument = return "" - | otherwise = E.throwIO e + | otherwise = UnliftIO.throwIO e receiveBuf :: Socket -> RecvBuf receiveBuf sock buf0 siz0 = do diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.3.15/Network/Wai/Handler/Warp/Request.hs new/warp-3.3.16/Network/Wai/Handler/Warp/Request.hs --- old/warp-3.3.15/Network/Wai/Handler/Warp/Request.hs 2021-04-16 06:44:27.000000000 +0200 +++ new/warp-3.3.16/Network/Wai/Handler/Warp/Request.hs 2021-05-26 07:02:00.000000000 +0200 @@ -14,7 +14,7 @@ ) where import qualified Control.Concurrent as Conc (yield) -import Control.Exception (throwIO, Exception) +import UnliftIO (throwIO, Exception) import Data.Array ((!)) import qualified Data.ByteString as S import qualified Data.ByteString.Unsafe as SU diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.3.15/Network/Wai/Handler/Warp/RequestHeader.hs new/warp-3.3.16/Network/Wai/Handler/Warp/RequestHeader.hs --- old/warp-3.3.15/Network/Wai/Handler/Warp/RequestHeader.hs 2021-04-16 06:44:27.000000000 +0200 +++ new/warp-3.3.16/Network/Wai/Handler/Warp/RequestHeader.hs 2021-05-26 07:02:00.000000000 +0200 @@ -4,7 +4,7 @@ parseHeaderLines ) where -import Control.Exception (throwIO) +import UnliftIO (throwIO) import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as C8 (unpack) import Data.ByteString.Internal (memchr) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.3.15/Network/Wai/Handler/Warp/Response.hs new/warp-3.3.16/Network/Wai/Handler/Warp/Response.hs --- old/warp-3.3.15/Network/Wai/Handler/Warp/Response.hs 2021-04-16 06:44:27.000000000 +0200 +++ new/warp-3.3.16/Network/Wai/Handler/Warp/Response.hs 2021-05-26 07:02:00.000000000 +0200 @@ -15,7 +15,7 @@ ) where import Data.ByteString.Builder.HTTP.Chunked (chunkedTransferEncoding, chunkedTransferTerminator) -import qualified Control.Exception as E +import qualified UnliftIO import Data.Array ((!)) import qualified Data.ByteString as S import Data.ByteString.Builder (byteString, Builder) @@ -275,9 +275,9 @@ -- Simple WAI applications. -- Status is ignored sendRsp conn ii th ver _ hs0 rspidxhdr (RspFile path Nothing reqidxhdr isHead hook) = do - efinfo <- E.try $ getFileInfo ii path + efinfo <- UnliftIO.tryIO $ getFileInfo ii path case efinfo of - Left (_ex :: E.IOException) -> + Left (_ex :: UnliftIO.IOException) -> #ifdef WARP_DEBUG print _ex >> #endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.3.15/Network/Wai/Handler/Warp/Run.hs new/warp-3.3.16/Network/Wai/Handler/Warp/Run.hs --- old/warp-3.3.15/Network/Wai/Handler/Warp/Run.hs 2021-04-16 06:44:27.000000000 +0200 +++ new/warp-3.3.16/Network/Wai/Handler/Warp/Run.hs 2021-05-26 07:02:00.000000000 +0200 @@ -8,7 +8,9 @@ module Network.Wai.Handler.Warp.Run where import Control.Arrow (first) -import Control.Exception as E +import Control.Exception (allowInterrupt) +import qualified UnliftIO +import UnliftIO (toException) import qualified Data.ByteString as S import Data.IORef (newIORef, readIORef) import Data.Streaming.Network (bindPortTCP) @@ -69,7 +71,7 @@ if tm == 0 then close s else - gracefulClose s tm `E.catch` \(E.SomeException _) -> return () + gracefulClose s tm `UnliftIO.catchAny` \(UnliftIO.SomeException _) -> return () #else , connClose = close s #endif @@ -81,11 +83,11 @@ , connHTTP2 = isH2 } where - sendAll' sock bs = E.handleJust + sendAll' sock bs = UnliftIO.handleJust (\ e -> if ioeGetErrorType e == ResourceVanished then Just ConnectionClosedByPeer else Nothing) - throwIO + UnliftIO.throwIO $ Sock.sendAll sock bs -- | Run an 'Application' on the given port. @@ -115,7 +117,7 @@ -- calls 'runSettingsSocket'. runSettings :: Settings -> Application -> IO () runSettings set app = withSocketsDo $ - bracket + UnliftIO.bracket (bindPortTCP (settingsPort set) (settingsHost set)) close (\socket -> do @@ -146,7 +148,7 @@ #endif setSocketCloseOnExec s -- NoDelay causes an error for AF_UNIX. - setSocketOption s NoDelay 1 `E.catch` \(E.SomeException _) -> return () + setSocketOption s NoDelay 1 `UnliftIO.catchAny` \(UnliftIO.SomeException _) -> return () conn <- socketConnection set s return (conn, sa) @@ -207,7 +209,7 @@ !timeoutInSeconds = settingsTimeout set * 1000000 withTimeoutManager f = case settingsManager set of Just tm -> f tm - Nothing -> bracket + Nothing -> UnliftIO.bracket (T.initialize timeoutInSeconds) T.stopManager f @@ -237,7 +239,7 @@ -- acceptNewConnection and the registering of connClose. -- -- acceptLoop can be broken by closing the listening socket. - void $ mask_ acceptLoop + void $ UnliftIO.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. @@ -262,7 +264,7 @@ acceptLoop acceptNewConnection = do - ex <- try getConnMaker + ex <- UnliftIO.tryIO getConnMaker case ex of Right x -> return $ Just x Left e -> do @@ -286,7 +288,7 @@ fork set mkConn addr app counter ii = settingsFork set $ \unmask -> -- Call the user-supplied on exception code if any -- exceptions are thrown. - handle (settingsOnException set Nothing) $ + UnliftIO.handleAny (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 @@ -297,20 +299,20 @@ -- 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. - bracket mkConn cleanUp (serve unmask) + UnliftIO.bracket mkConn cleanUp (serve unmask) where - cleanUp (conn, _) = connClose conn `finally` connFree conn + cleanUp (conn, _) = connClose conn `UnliftIO.finally` connFree conn -- We need to register a timeout handler for this thread, and -- cancel that handler as soon as we exit. - serve unmask (conn, transport) = bracket register cancel $ \th -> do + serve unmask (conn, transport) = UnliftIO.bracket register cancel $ \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. unmask . -- Call the user-supplied code for connection open and -- close events - bracket (onOpen addr) (onClose addr) $ \goingon -> + UnliftIO.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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.3.15/Network/Wai/Handler/Warp/SendFile.hs new/warp-3.3.16/Network/Wai/Handler/Warp/SendFile.hs --- old/warp-3.3.15/Network/Wai/Handler/Warp/SendFile.hs 2021-04-16 06:44:27.000000000 +0200 +++ new/warp-3.3.16/Network/Wai/Handler/Warp/SendFile.hs 2021-05-26 07:02:00.000000000 +0200 @@ -17,7 +17,7 @@ import Foreign.Ptr (plusPtr) import qualified System.IO as IO #else -import Control.Exception +import qualified UnliftIO import Foreign.C.Error (throwErrno) import Foreign.C.Types import Foreign.Ptr (Ptr, castPtr, plusPtr) @@ -112,7 +112,7 @@ #else readSendFile :: Buffer -> BufSize -> (ByteString -> IO ()) -> SendFile readSendFile buf siz send fid off0 len0 hook headers = - bracket setup teardown $ \fd -> do + UnliftIO.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.3.15/Network/Wai/Handler/Warp/Settings.hs new/warp-3.3.16/Network/Wai/Handler/Warp/Settings.hs --- old/warp-3.3.15/Network/Wai/Handler/Warp/Settings.hs 2021-04-16 06:44:27.000000000 +0200 +++ new/warp-3.3.16/Network/Wai/Handler/Warp/Settings.hs 2021-05-26 07:02:00.000000000 +0200 @@ -5,7 +5,7 @@ module Network.Wai.Handler.Warp.Settings where import Control.Concurrent (forkIOWithUnmask) -import Control.Exception +import UnliftIO (SomeException, fromException) import qualified Data.ByteString.Char8 as C8 import qualified Data.ByteString.Builder as Builder import Data.ByteString.Lazy (fromStrict) @@ -13,7 +13,7 @@ import qualified Data.Text as T import qualified Data.Text.IO as TIO import Data.Version (showVersion) -import GHC.IO.Exception (IOErrorType(..)) +import GHC.IO.Exception (IOErrorType(..), AsyncException (ThreadKilled)) import qualified Network.HTTP.Types as H import Network.HTTP2.Frame (HTTP2Error (..), ErrorCodeId (..)) import Network.Socket (SockAddr) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.3.15/Network/Wai/Handler/Warp/Types.hs new/warp-3.3.16/Network/Wai/Handler/Warp/Types.hs --- old/warp-3.3.15/Network/Wai/Handler/Warp/Types.hs 2021-04-16 06:44:27.000000000 +0200 +++ new/warp-3.3.16/Network/Wai/Handler/Warp/Types.hs 2021-05-26 07:02:00.000000000 +0200 @@ -4,7 +4,7 @@ module Network.Wai.Handler.Warp.Types where -import Control.Exception +import qualified UnliftIO import qualified Data.ByteString as S import Data.IORef (IORef, readIORef, writeIORef, newIORef) import Data.Typeable (Typeable) @@ -49,7 +49,7 @@ show OverLargeHeader = "Warp: Request headers too large, possible memory attack detected. Closing connection." show (BadProxyHeader s) = "Warp: Invalid PROXY protocol header: " ++ show s -instance Exception InvalidRequest +instance UnliftIO.Exception InvalidRequest ---------------------------------------------------------------- @@ -60,10 +60,10 @@ -- Used to determine whether keeping the HTTP1.1 connection / HTTP2 stream alive is safe -- or irrecoverable. -newtype ExceptionInsideResponseBody = ExceptionInsideResponseBody SomeException +newtype ExceptionInsideResponseBody = ExceptionInsideResponseBody UnliftIO.SomeException deriving (Show, Typeable) -instance Exception ExceptionInsideResponseBody +instance UnliftIO.Exception ExceptionInsideResponseBody ---------------------------------------------------------------- diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.3.15/Network/Wai/Handler/Warp/Windows.hs new/warp-3.3.16/Network/Wai/Handler/Warp/Windows.hs --- old/warp-3.3.15/Network/Wai/Handler/Warp/Windows.hs 2021-04-16 06:44:27.000000000 +0200 +++ new/warp-3.3.16/Network/Wai/Handler/Warp/Windows.hs 2021-05-26 07:02:00.000000000 +0200 @@ -4,9 +4,9 @@ ) where #if WINDOWS -import Control.Exception import Control.Concurrent.MVar import Control.Concurrent +import qualified Control.Exception import Network.Wai.Handler.Warp.Imports @@ -15,11 +15,12 @@ -- @since 3.2.17 windowsThreadBlockHack :: IO a -> IO a windowsThreadBlockHack act = do - var <- newEmptyMVar :: IO (MVar (Either SomeException a)) - void . forkIO $ try act >>= putMVar var + var <- newEmptyMVar :: IO (MVar (Either Control.Exception.SomeException a)) + -- Catch and rethrow even async exceptions, so don't bother with UnliftIO + void . forkIO $ Control.Exception.try act >>= putMVar var res <- takeMVar var case res of - Left e -> throwIO e + Left e -> Control.Exception.throwIO e Right r -> return r #else windowsThreadBlockHack :: IO a -> IO a diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.3.15/Network/Wai/Handler/Warp/WithApplication.hs new/warp-3.3.16/Network/Wai/Handler/Warp/WithApplication.hs --- old/warp-3.3.15/Network/Wai/Handler/Warp/WithApplication.hs 2021-04-16 06:44:27.000000000 +0200 +++ new/warp-3.3.16/Network/Wai/Handler/Warp/WithApplication.hs 2021-05-26 07:02:00.000000000 +0200 @@ -9,8 +9,8 @@ ) where import Control.Concurrent -import Control.Concurrent.Async -import Control.Exception +import qualified UnliftIO +import UnliftIO.Async import Control.Monad (when) import Data.Streaming.Network (bindRandomPortTCP) import Network.Socket @@ -45,7 +45,7 @@ (runSettingsSocket settings sock app) (waitFor started >> action port) case result of - Left () -> throwIO $ ErrorCall "Unexpected: runSettingsSocket exited" + Left () -> UnliftIO.throwString "Unexpected: runSettingsSocket exited" Right x -> return x -- | Same as 'withApplication' but with different exception handling: If the @@ -72,11 +72,11 @@ callingThread <- myThreadId app <- mkApp let wrappedApp request respond = - app request respond `catch` \ e -> do + app request respond `UnliftIO.catchAny` \ e -> do when (defaultShouldDisplayException e) (throwTo callingThread e) - throwIO e + UnliftIO.throwIO e withApplicationSettings settings (return wrappedApp) action data Waiter a @@ -101,4 +101,4 @@ -- | Like 'openFreePort' but closes the socket before exiting. withFreePort :: ((Port, Socket) -> IO a) -> IO a -withFreePort = bracket openFreePort (close . snd) +withFreePort = UnliftIO.bracket openFreePort (close . snd) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.3.15/Network/Wai/Handler/Warp.hs new/warp-3.3.16/Network/Wai/Handler/Warp.hs --- old/warp-3.3.15/Network/Wai/Handler/Warp.hs 2021-04-16 06:44:27.000000000 +0200 +++ new/warp-3.3.16/Network/Wai/Handler/Warp.hs 2021-05-26 07:02:00.000000000 +0200 @@ -125,7 +125,7 @@ , defaultPushPromise ) where -import Control.Exception (SomeException, throwIO) +import UnliftIO.Exception (SomeException, throwIO) import Data.Streaming.Network (HostPreference) import qualified Data.Vault.Lazy as Vault import Data.X509 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.3.15/bench/Parser.hs new/warp-3.3.16/bench/Parser.hs --- old/warp-3.3.15/bench/Parser.hs 2021-04-16 06:44:27.000000000 +0200 +++ new/warp-3.3.16/bench/Parser.hs 2021-05-26 07:02:00.000000000 +0200 @@ -4,7 +4,6 @@ module Main where -import Control.Exception (throwIO, throw) import Control.Monad import qualified Data.ByteString as S --import Data.ByteString.Char8 (ByteString) @@ -12,6 +11,7 @@ import qualified Network.HTTP.Types as H import Network.Wai.Handler.Warp.Types import Prelude hiding (lines) +import UnliftIO.Exception (throwIO, impureThrow) import Data.ByteString.Internal import Data.Word @@ -70,14 +70,14 @@ where (!method,!rest) = S.break (== 32) requestLine -- ' ' (!pathQuery,!httpVer') - | rest == "" = throw badmsg + | rest == "" = impureThrow badmsg | otherwise = S.break (== 32) (S.drop 1 rest) -- ' ' (!path,!query) = S.break (== 63) pathQuery -- '?' !httpVer = S.drop 1 httpVer' (!http,!ver) - | httpVer == "" = throw badmsg + | httpVer == "" = impureThrow badmsg | otherwise = S.break (== 47) httpVer -- '/' - !hv | http /= "HTTP" = throw NonHttp + !hv | http /= "HTTP" = impureThrow 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.3.15/test/ExceptionSpec.hs new/warp-3.3.16/test/ExceptionSpec.hs --- old/warp-3.3.15/test/ExceptionSpec.hs 2021-04-16 06:44:27.000000000 +0200 +++ new/warp-3.3.16/test/ExceptionSpec.hs 2021-05-26 07:02:00.000000000 +0200 @@ -11,9 +11,9 @@ import Network.Wai.Internal (Request(..)) import Network.Wai.Handler.Warp import Test.Hspec -import Control.Exception +import UnliftIO.Exception import qualified Data.Streaming.Network as N -import Control.Concurrent.Async (withAsync) +import UnliftIO.Async (withAsync) import Network.Socket (close) import HTTP diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.3.15/test/RunSpec.hs new/warp-3.3.16/test/RunSpec.hs --- old/warp-3.3.15/test/RunSpec.hs 2021-04-16 06:44:27.000000000 +0200 +++ new/warp-3.3.16/test/RunSpec.hs 2021-05-26 07:02:00.000000000 +0200 @@ -6,8 +6,8 @@ import Control.Concurrent (forkIO, killThread, threadDelay) import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar) import Control.Concurrent.STM -import qualified Control.Exception as E -import Control.Exception.Lifted (bracket, try, IOException, onException) +import qualified UnliftIO.Exception as E +import UnliftIO.Exception (bracket, try, IOException, onException) import Control.Monad (forM_, replicateM_, unless) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.ByteString (ByteString) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.3.15/test/SendFileSpec.hs new/warp-3.3.16/test/SendFileSpec.hs --- old/warp-3.3.15/test/SendFileSpec.hs 2021-04-16 06:44:27.000000000 +0200 +++ new/warp-3.3.16/test/SendFileSpec.hs 2021-05-26 07:02:00.000000000 +0200 @@ -2,7 +2,6 @@ module SendFileSpec where -import Control.Exception import Control.Monad (when) import Data.ByteString (ByteString) import qualified Data.ByteString as BS @@ -14,6 +13,7 @@ import qualified System.IO as IO import System.Process (system) import Test.Hspec +import UnliftIO.Exception main :: IO () main = hspec spec diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.3.15/test/WithApplicationSpec.hs new/warp-3.3.16/test/WithApplicationSpec.hs --- old/warp-3.3.15/test/WithApplicationSpec.hs 2021-04-16 06:44:27.000000000 +0200 +++ new/warp-3.3.16/test/WithApplicationSpec.hs 2021-05-26 07:02:00.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 @@ -24,17 +24,17 @@ output `shouldBe` "foo" it "does not propagate exceptions from the server to the executing thread" $ do - let mkApp = return $ \ _request _respond -> throwIO $ ErrorCall "foo" + let mkApp = return $ \ _request _respond -> throwString "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 -> throwIO $ ErrorCall "foo" + let mkApp = return $ \ _request _respond -> throwString "foo" (testWithApplication mkApp $ \ port -> do readProcess "curl" ["-s", "localhost:" ++ show port] "") - `shouldThrow` (errorCall "foo") + `shouldThrow` (\(StringException str _) -> str == "foo") {- The future netwrok library will not export MkSocket. describe "withFreePort" $ do diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/warp-3.3.15/warp.cabal new/warp-3.3.16/warp.cabal --- old/warp-3.3.15/warp.cabal 2021-04-16 06:44:27.000000000 +0200 +++ new/warp-3.3.16/warp.cabal 2021-05-26 07:02:00.000000000 +0200 @@ -1,5 +1,5 @@ Name: warp -Version: 3.3.15 +Version: 3.3.16 Synopsis: A fast, light-weight web server for WAI applications. License: MIT License-file: LICENSE @@ -33,9 +33,8 @@ Default: False Library - Build-Depends: base >= 4.10 && < 5 + Build-Depends: base >= 4.12 && < 5 , array - , async , auto-update >= 0.1.3 && < 0.2 , bsb-http-chunked < 0.1 , bytestring >= 0.9.1.4 @@ -57,6 +56,7 @@ , wai >= 3.2 && < 3.3 , word8 , x509 + , unliftio if impl(ghc < 8) Build-Depends: semigroups if flag(network-bytestring) @@ -201,7 +201,6 @@ , http-types >= 0.12 , http2 >= 3.0 && < 3.1 , iproute >= 1.3.1 - , lifted-base >= 0.1 , network , process , simple-sendfile >= 0.2.4 && < 0.3 @@ -215,6 +214,7 @@ , wai >= 3.2 && < 3.3 , word8 , x509 + , unliftio -- Build-Tool-Depends: hspec-discover:hspec-discover if impl(ghc < 8) Build-Depends: semigroups @@ -254,6 +254,7 @@ , time-manager , unix-compat , x509 + , unliftio if impl(ghc < 8) Build-Depends: semigroups
