warp 3.4.3 → 3.4.4
raw patch · 24 files changed
+138/−121 lines, 24 filesdep +asyncdep +criteriondep −gaugedep −unliftiodep ~auto-update
Dependencies added: async, criterion
Dependencies removed: gauge, unliftio
Dependency ranges changed: auto-update
Files
- ChangeLog.md +4/−0
- Network/Wai/Handler/Warp.hs +1/−1
- Network/Wai/Handler/Warp/Conduit.hs +1/−1
- Network/Wai/Handler/Warp/Date.hs +7/−1
- Network/Wai/Handler/Warp/FdCache.hs +2/−1
- Network/Wai/Handler/Warp/FileInfoCache.hs +7/−6
- Network/Wai/Handler/Warp/HTTP1.hs +27/−28
- Network/Wai/Handler/Warp/HTTP2.hs +17/−8
- Network/Wai/Handler/Warp/HTTP2/PushPromise.hs +3/−3
- Network/Wai/Handler/Warp/HTTP2/Response.hs +3/−3
- Network/Wai/Handler/Warp/Request.hs +1/−1
- Network/Wai/Handler/Warp/RequestHeader.hs +1/−1
- Network/Wai/Handler/Warp/Response.hs +3/−3
- Network/Wai/Handler/Warp/Run.hs +27/−24
- Network/Wai/Handler/Warp/SendFile.hs +2/−2
- Network/Wai/Handler/Warp/Settings.hs +1/−1
- Network/Wai/Handler/Warp/Types.hs +4/−4
- Network/Wai/Handler/Warp/WithApplication.hs +6/−6
- bench/Parser.hs +5/−10
- test/ExceptionSpec.hs +2/−2
- test/RunSpec.hs +2/−2
- test/SendFileSpec.hs +1/−1
- test/WithApplicationSpec.hs +4/−4
- warp.cabal +7/−8
ChangeLog.md view
@@ -1,5 +1,9 @@ # ChangeLog for warp +## 3.4.4++* Removing `unliftio`.+ ## 3.4.3 * Waiting untill the number of FDs desreases on EMFILE.
Network/Wai/Handler/Warp.hs view
@@ -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
Network/Wai/Handler/Warp/Conduit.hs view
@@ -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
Network/Wai/Handler/Warp/Date.hs view
@@ -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
Network/Wai/Handler/Warp/FdCache.hs view
@@ -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)
Network/Wai/Handler/Warp/FileInfoCache.hs view
@@ -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)
Network/Wai/Handler/Warp/HTTP1.hs view
@@ -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@@ -151,7 +150,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 +165,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 +191,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.@@ -226,27 +225,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
Network/Wai/Handler/Warp/HTTP2.hs view
@@ -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,12 @@ let msiz = fromIntegral <$> H2.responseBodySize h2rsp logResponse req st msiz mapM_ (logPushPromise req) pps- Left e -> do+ Left e+ -- 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 S.settingsOnException settings (Just req) e let ersp = S.settingsOnExceptionResponse settings e st = responseStatus ersp@@ -131,7 +140,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,7 +151,7 @@ T.tickle th return bs where- handler :: UnliftIO.SomeException -> IO ByteString+ handler :: E.SomeException -> IO ByteString handler _ = return "" -- connClose must not be called here since Run:fork calls it
Network/Wai/Handler/Warp/HTTP2/PushPromise.hs view
@@ -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
Network/Wai/Handler/Warp/HTTP2/Response.hs view
@@ -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
Network/Wai/Handler/Warp/Request.hs view
@@ -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
Network/Wai/Handler/Warp/RequestHeader.hs view
@@ -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
Network/Wai/Handler/Warp/Response.hs view
@@ -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
Network/Wai/Handler/Warp/Run.hs view
@@ -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` \(E.SomeException _) -> 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` \(E.SomeException _) -> 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) = E.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.@@ -363,7 +363,7 @@ . -- 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.@@ -386,6 +386,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 +397,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
Network/Wai/Handler/Warp/SendFile.hs view
@@ -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
Network/Wai/Handler/Warp/Settings.hs view
@@ -9,6 +9,7 @@ module Network.Wai.Handler.Warp.Settings where +import Control.Exception (SomeException, fromException) import qualified Data.ByteString.Builder as Builder import qualified Data.ByteString.Char8 as C8 import Data.Streaming.Network (HostPreference)@@ -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
Network/Wai/Handler/Warp/Types.hs view
@@ -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 ----------------------------------------------------------------
Network/Wai/Handler/Warp/WithApplication.hs view
@@ -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)
bench/Parser.hs view
@@ -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)
test/ExceptionSpec.hs view
@@ -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
test/RunSpec.hs view
@@ -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
test/SendFileSpec.hs view
@@ -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
test/WithApplicationSpec.hs view
@@ -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")
warp.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: warp-version: 3.4.3+version: 3.4.4 license: MIT license-file: LICENSE maintainer: michael@snoyman.com@@ -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,@@ -104,8 +105,7 @@ time-manager >=0.1 && <0.2, 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