warp 3.4.17 → 3.4.18

raw patch · 7 files changed

+307/−119 lines, 7 filesdep ~networkdep ~recvdep ~time-managerPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: network, recv, time-manager

API changes (from Hackage documentation)

Files

• ChangeLog.md +21/−0
• Network/Wai/Handler/Warp/Counter.hs +42/−20
• Network/Wai/Handler/Warp/Internal.hs +7/−0
• Network/Wai/Handler/Warp/Run.hs +145/−75
• test/GracefulShutdownSpec.hs +77/−15
• test/ServerStateSpec.hs +10/−4
• warp.cabal +5/−5

@@ -1,5 +1,26 @@ # ChangeLog for warp +## 3.4.18++* The accept loop is stopped by being told, through the new+  `settingsInstallShutdownHandler`, rather than by having the listening+  socket closed under it, and the graceful shutdown's receive is one+  `receiveWith`.  Nothing is closed and no thread is interrupted to make+  either of them return: a close ends a thread blocked on a descriptor+  only because the event manager says so, which GHC is removing, and an+  asynchronous exception does not reach a thread blocked in a socket call+  on Windows -- where, before this, a server could not be stopped at all.+  [#1136](https://github.com/yesodweb/wai/issues/1136)+* The threads serving connections are owned by a thread manager, so a+  killed server no longer leaves them running, and a connection which has+  been accepted but not yet scheduled is counted by `gracefulShutdown`+  rather than being invisible to it.+  [#1126](https://github.com/yesodweb/wai/issues/1126)+  [#1132](https://github.com/yesodweb/wai/issues/1132)+* `Internal` exports `Listener (..)`, `noListener`, `makeListener`,+  `AcceptStopped (..)` and `runSettingsConnectionMakerSecureWith`.+* Requires network 3.2.10, recv 0.1.3 and time-manager 0.5.+ ## 3.4.17  * Security: `Transfer-Encoding` is read as the comma separated list RFC 9112

@@ -1,58 +1,80 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-}  module Network.Wai.Handler.Warp.Counter (     Counter,     newCounter,     HasDecreased (..),     waitForZero,-    increase,-    decrease,+    forkConnection,     waitForDecreased,     getCount,     getCountSTM,+    threadManager, ) where  import Control.Concurrent.STM--import Network.Wai.Handler.Warp.Imports+import System.ThreadManager (+    ThreadManager,+    countManaged,+    forkManagedBy,+    newThreadManager,+    waitUntilAllGone,+ ) -newtype Counter = Counter (TVar Int)+-- | The connections of a server: how many there are, and which threads+--   are serving them.+--+--   Both come from the 'ThreadManager', which counts a connection from+--   when the accept loop keeps a place for it -- before the thread that+--   will serve it has been scheduled, which is too late for a graceful+--   shutdown to notice it.+newtype Counter = Counter ThreadManager  newCounter :: IO Counter-newCounter = Counter <$> newTVarIO 0+newCounter = Counter <$> newThreadManager +-- | The manager owning the connections, for supervising them.+threadManager :: Counter -> ThreadManager+threadManager (Counter tm) = tm+ waitForZero :: Counter -> IO ()-waitForZero (Counter var) = atomically $ do-    x <- readTVar var-    when (x > 0) retry+waitForZero (Counter tm) = waitUntilAllGone tm  data HasDecreased = HasDecreased | NoConnections     deriving (Eq, Show)  waitForDecreased :: Counter -> IO HasDecreased-waitForDecreased (Counter var) = do-    n0 <- atomically $ readTVar var+waitForDecreased (Counter tm) = do+    n0 <- atomically $ countManaged tm     if n0 <= 0         then pure NoConnections         else atomically $ do-            n <- readTVar var+            n <- countManaged tm             check (n < n0)             pure HasDecreased -increase :: Counter -> IO ()-increase (Counter var) = atomically $ modifyTVar' var $ \x -> x + 1--decrease :: Counter -> IO ()-decrease (Counter var) = atomically $ modifyTVar' var $ \x -> x - 1+-- | Serving a connection on a thread made by the given fork.  The+--   connection is counted from here rather than from when that thread+--   starts: the accept loop does not wait for it, and a connection which+--   has been accepted must not look to 'waitForZero' like one that is+--   gone.+forkConnection+    :: Counter+    -> (((forall x. IO x -> IO x) -> IO ()) -> IO ())+    -- ^ The fork from the settings+    -> ((forall x. IO x -> IO x) -> IO ())+    -- ^ Serving the connection+    -> IO ()+forkConnection (Counter tm) fork io = forkManagedBy tm fork "Warp just forked" io  -- | Get the current count of open connections. -- -- @since 3.4.11 getCount :: Counter -> IO Int-getCount (Counter var) = readTVarIO var+getCount = atomically . getCountSTM  -- | Get the current count in an 'STM' transaction. -- -- @since 3.4.13 getCountSTM :: Counter -> STM Int-getCountSTM (Counter tvar) = readTVar tvar+getCountSTM (Counter tm) = countManaged tm

@@ -29,7 +29,14 @@     runSettingsConnection,     runSettingsConnectionMaker,     runSettingsConnectionMakerSecure,+    runSettingsConnectionMakerSecureWith,     Transport (..),++    -- ** Stopping the accept loop+    Listener (..),+    noListener,+    makeListener,+    AcceptStopped (..),      -- * Connection     Connection (..),

@@ -17,13 +17,13 @@     modifyTVar',     newTVarIO,     readTVar,+    writeTVar,  ) import qualified Control.Exception as E import qualified Data.ByteString as S-import Data.Functor (($>)) import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Streaming.Network (bindPortTCP)-import Foreign.C.Error (Errno (..), eCONNABORTED, eMFILE)+import Foreign.C.Error (Errno (..), eMFILE) import GHC.Conc.Sync (labelThread, myThreadId) import GHC.IO.Exception (IOErrorType (..), IOException (..)) import Network.Socket (@@ -33,11 +33,11 @@     close, #if !WINDOWS     fdSocket,-#if MIN_VERSION_network(3,2,2)-    waitReadSocketSTM, #endif-#endif     getSocketName,+    isClosedSocketError,+    isTransientAcceptError,+    withReadable,     setSocketOption,     withSocketsDo,  )@@ -49,6 +49,7 @@ import Network.Wai import System.Environment (lookupEnv) import System.IO.Error (ioeGetErrorType)+import qualified System.ThreadManager as T import qualified System.TimeManager as T import System.Timeout (timeout) @@ -63,7 +64,7 @@ import Network.Wai.Handler.Warp.Imports hiding (readInt) import Network.Wai.Handler.Warp.SendFile (sendFile) import Network.Wai.Handler.Warp.Settings-import Network.Wai.Handler.Warp.ShuttingDown (readShuttingDown, writeShuttingDown)+import Network.Wai.Handler.Warp.ShuttingDown (writeShuttingDown) import Network.Wai.Handler.Warp.Types  -- | Creating 'Connection' for plain HTTP based on a given socket.@@ -136,44 +137,21 @@             E.throwIO             $ Sock.sendAll s bs --- | Create a 'Recv' using 'Network.Socket.BufferPool.Recv.receive', but make--- it non-blocking with 'waitReadSocketSTM' /AND/ cut off receiving any bytes--- when the server is shutting down and there are no more 'Application's--- actively using this 'Socket'.+-- | Create a 'Recv' which stops receiving when the server is shutting down+-- and no 'Application' is still using this 'Socket'.+--+-- Nothing is closed and no thread is interrupted to make it return: the+-- read and the shutdown are waited for at once, inside 'receiveWith'. makeGracefulRecv :: Socket -> BufferPool -> ServerState -> TVar Int -> Recv makeGracefulRecv sock pool ss appsInProgress = do-    tryFastPath <- not <$> readShuttingDown (serverShuttingDown ss)-    if tryFastPath then do-        mbs <- receiveNoWait sock pool-        case mbs of-          Just bs -> return bs-          Nothing -> slowPath-      else slowPath-  where-    slowPath = makeGracefulRecvSlow sock pool ss appsInProgress--makeGracefulRecvSlow :: Socket -> BufferPool -> ServerState -> TVar Int -> Recv-makeGracefulRecvSlow sock pool ss appsInProgress = do-    sockWait <--#if !WINDOWS && MIN_VERSION_network(3,2,2)-        waitReadSocketSTM sock-#else-        -- FIXME: 'waitReadSocketSTM' doesn't work on WINDOWS, and actually-        -- blocks indefinitely, so we fall back to going straight to 'recv'.-        pure (pure ())-#endif-    isShuttingDown <- atomically $-        -- when shutting down-        (checkShutdown $> True)-        <|>-        -- else wait for socket readiness and do non-blocking read-        (sockWait $> False)-    if isShuttingDown then pure "" else recv+    r <- receiveWith sock pool checkShutdown+    case r of+        Left () -> return ""+        Right bs -> return bs   where-    recv = receive sock pool     checkShutdown = do-       check =<< currentShuttingDownStateSTM ss-       check . (<= 0) =<< readTVar appsInProgress+        check =<< currentShuttingDownStateSTM ss+        check . (<= 0) =<< readTVar appsInProgress  -- | Run an 'Application' on the given port. -- This calls 'runSettings' with 'defaultSettings'.@@ -210,33 +188,94 @@                 runSettingsSocket set socket app             ) --- | This installs a shutdown handler for the given socket and--- calls 'runSettingsConnection' with the default connection setup action--- which handles plain (non-cipher) HTTP.--- When the listen socket in the second argument is closed, all live--- connections are gracefully shut down.+-- | What the accept loop waits on at the top of each turn, and what it+--   leaves behind when it stops. --+-- A server used to be stopped by closing the listening socket under the+-- thread waiting in @accept@ on it.  That takes an IO manager that can wake+-- a thread out of a wait by closing the file descriptor under it, which is+-- what 'GHC.Conc.closeFdWith' is for, and the IO manager that provides it+-- is not the only one there will be.  So the loop waits for the socket and+-- for the shutdown at once and ends on whichever comes first; the socket is+-- closed after it, by which time nothing is waiting on it.+data Listener = Listener+    { acceptOrStop :: IO (Maybe (Socket, SockAddr))+    -- ^ Accepts a connection.  'Nothing' instead once the server has been+    -- asked to stop: giving up has to be composed with the accept itself,+    -- so the accept belongs here rather than beside it.+    , closeListener :: IO ()+    -- ^ Run once the accept loop has ended and before the connections are+    -- waited for: the port is a successor's to take, and a successor should+    -- not have to wait out someone else's drain for it.+    }++-- | For a caller that handed warp a connection maker and no socket.  There+--   is nothing here to accept and nothing to close, and such a server ends+--   the way it always did: by whatever its maker accepts on being closed.+noListener :: Listener+noListener = Listener{acceptOrStop = return Nothing, closeListener = return ()}++-- | Thrown by a connection maker which was told to stop rather than handed+--   a connection, and caught by the accept loop.  A maker has to return a+--   connection or throw, so this is how it says that there will not be one.+data AcceptStopped = AcceptStopped deriving (Show)++instance E.Exception AcceptStopped++makeListener :: Settings -> Socket -> IO Listener+makeListener set socket = do+    stopping <- newTVarIO False+    settingsInstallShutdownHandler set $ atomically $ writeTVar stopping True+    return+        Listener+            { acceptOrStop = closedAsStopped $ do+                r <- withReadable socket (told stopping) $ settingsAccept set socket+                return $ either (const Nothing) Just r+            , closeListener = close socket+            }+  where+    told stopping = check =<< readTVar stopping+    -- Closing the listening socket is how a server was stopped before there+    -- was anything to tell, and callers that do it are still out there. It+    -- means the same thing the shutdown handler means: stop accepting.+    -- Ending the loop quietly is what happened before, and 'closeListener'+    -- closing an already-closed socket is no error.+    closedAsStopped = E.handle $ \e ->+        if isClosedSocketError e then return Nothing else E.throwIO e++-- | This installs a shutdown handler for the given socket and runs the+-- default connection setup action, which handles plain (non-cipher) HTTP.+-- Running the handler stops the server accepting, closes the listening+-- socket, and gracefully shuts the live connections down.+-- -- The supplied socket can be a Unix named socket, which -- can be used when reverse HTTP proxying into your application. -- -- Note that the 'settingsPort' will still be passed to 'Application's via the -- 'serverPort' record. runSettingsSocket :: Settings -> Socket -> Application -> IO ()-runSettingsSocket oldSettings@Settings{settingsAccept = accept'} socket app = do-    settingsInstallShutdownHandler oldSettings closeListenSocket+runSettingsSocket oldSettings socket app = do+    listener <- makeListener oldSettings socket     (_, newSettings) <- makeServerState oldSettings-    runSettingsConnection newSettings (getConn newSettings) app+    runSettingsConnectionMakerSecureWith+        newSettings+        listener+        (first ((,TCP) <$>) <$> getConnMaker listener newSettings)+        app   where-    getConn set = do-        (s, sa) <- accept' socket+    getConnMaker listener set = do+        (conn, sa) <- getConn listener set+        return (return conn, sa)++    getConn listener set = do+        macc <- acceptOrStop listener+        (s, sa) <- maybe (E.throwIO AcceptStopped) return macc         setSocketCloseOnExec s         -- NoDelay causes an error for AF_UNIX.         setSocketOption s NoDelay 1 `E.catch` throughAsync (return ())         conn <- socketConnection set s         return (conn, sa) -    closeListenSocket = close socket- -- | The connection setup action would be expensive. A good example -- is initialization of TLS. -- So, this converts the connection setup action to the connection maker@@ -273,12 +312,23 @@ -- @since 2.1.4 runSettingsConnectionMakerSecure     :: Settings -> IO (IO (Connection, Transport), SockAddr) -> Application -> IO ()-runSettingsConnectionMakerSecure oldSettings getConnMaker app = do+runSettingsConnectionMakerSecure set = runSettingsConnectionMakerSecureWith set noListener++-- | 'runSettingsConnectionMakerSecure' for a caller that has the listening+--   socket, and so can say how the accept loop waits on it and what becomes+--   of it when the loop stops.+runSettingsConnectionMakerSecureWith+    :: Settings+    -> Listener+    -> IO (IO (Connection, Transport), SockAddr)+    -> Application+    -> IO ()+runSettingsConnectionMakerSecureWith oldSettings listener getConnMaker app = do     settingsBeforeMainLoop oldSettings     (ServerState{serverConnectionCounter}, newSettings) <- makeServerState oldSettings     withII newSettings $ \ii ->         initFdExhaustionRef >>=-            acceptConnection newSettings getConnMaker app serverConnectionCounter ii+            acceptConnection newSettings listener getConnMaker app serverConnectionCounter ii  -- | Running an action with internal info. --@@ -318,6 +368,7 @@ -- Our approach is explained in the comments below. acceptConnection     :: Settings+    -> Listener     -> IO (IO (Connection, Transport), SockAddr)     -> Application     -> Counter@@ -327,17 +378,28 @@         -- when we hit an 'IOError' with 'eMFILE' in the case that Warp is not         -- the reason the file descriptors are exhausted.     -> IO ()-acceptConnection set getConnMaker app counter ii fdRef = do+acceptConnection set listener getConnMaker app counter ii fdRef = do     -- First mask all exceptions in acceptLoop. This is necessary to     -- ensure that no async exception is throw between the call to     -- acceptNewConnection and the registering of connClose.     ---    -- acceptLoop can be broken by closing the listening socket.-    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.-    gracefulShutdown set counter+    -- acceptLoop ends when the listener says the server has been asked+    -- to stop.+    -- Whatever ends the loop, the connections being served do not outlive+    -- it: 'stopAfter' kills what the manager still owns and rethrows.+    -- Warp forks a thread per connection and nothing else owns them, so+    -- without this they go on running after the caller of 'runSettings'+    -- has been handed its exception back.  See #1126.+    flip (T.stopAfter (threadManager counter)) (const $ return ()) $ do+        void $ E.mask_ acceptLoop+        -- Nothing is waiting on the listening socket any more, so it can be+        -- closed and the port left to a successor rather than held for as+        -- long as the connections below take to finish.+        closeListener listener+        -- 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.+        gracefulShutdown set counter   where     acceptLoop = do         -- Allow async exceptions before receiving the next connection maker.@@ -357,7 +419,12 @@                 fork set mkConn addr app counter ii                 acceptLoop -    acceptNewConnection = do+    -- The maker throws this when the server has been asked to stop, which+    -- is not a failure to report.+    acceptNewConnection =+        acceptNewConnection' `E.catch` \AcceptStopped -> return Nothing++    acceptNewConnection' = do         ex <- E.try getConnMaker         case ex of             Right x -> do@@ -368,15 +435,20 @@             Left e -> do                 let getErrno (Errno cInt) = cInt                     isErrno err = ioe_errno e == Just (getErrno err)-                if | isErrno eCONNABORTED -> do+                -- isTransientAcceptError is about one queued connection+                -- rather than about the listening socket, and says which+                -- errno those are. The connection has left the queue by+                -- then, so the retry blocks for a new one rather than+                -- spinning on the same failure.+                if | isTransientAcceptError e -> do                         -- Important to mark the exhaustion issue to be resolved                         resetFdExhaustion fdRef-                        acceptNewConnection+                        acceptNewConnection'                      -- Keep in mind to reset the ref when anything other                      -- than this branch runs                    | isErrno eMFILE -> do                         handleFdExhaustion e-                        acceptNewConnection+                        acceptNewConnection'                    | otherwise -> do                         -- Maybe not important to mark the exhaustion issue                         -- as resolved here, but just for completeness' sake.@@ -408,17 +480,15 @@     -> Counter     -> InternalInfo     -> IO ()-fork set mkConn addr app counter ii = do-    -- Count the connection here rather than in the thread below.  The-    -- accept loop does not wait for that thread to be scheduled, so-    -- counting there leaves a window in which the connection is accepted-    -- and not counted, and 'gracefulShutdown' waits on this counter.-    increase counter-    settingsFork set $ \unmask -> runConnection unmask `E.finally` decrease counter+fork set mkConn addr app counter ii =+    -- The connection is counted from here rather than from the thread+    -- below.  The accept loop does not wait for that thread to be+    -- scheduled, so counting there leaves a window in which the connection+    -- is accepted and not counted, and 'gracefulShutdown' waits on this+    -- counter.+    forkConnection counter (settingsFork set) runConnection   where-    runConnection unmask = do-        tid <- myThreadId-        labelThread tid "Warp just forked"+    runConnection unmask =         -- Call the user-supplied on exception code if any         -- exceptions are thrown.         --

@@ -8,44 +8,95 @@ import Control.Concurrent import Control.Concurrent.Async import Control.Exception (bracket)+import qualified Control.Exception as E import Control.Monad (void) import Data.IORef import Network.HTTP.Client import Network.HTTP.Types (ok200, status200) import Network.Socket+import Network.Socket.ByteString (sendAll) import Network.Wai (responseLBS) import Network.Wai.Handler.Warp+import System.ThreadManager (KilledByThreadManager (..)) import System.Timeout (timeout) import Test.Hspec  spec :: Spec spec = describe "graceful shutdown" $ do+    it "kills what it is still serving when it is killed itself (#1126)" $ do+        -- Warp forks a thread per connection, and nothing in the runtime+        -- makes those the children of the thread running the server.  An+        -- asynchronous exception to that thread used to leave them running.+        servingNow <- newEmptyMVar+        killed <- newEmptyMVar+        let app _ respond =+                ( do+                    putMVar servingNow ()+                    threadDelay 10_000_000+                    respond $ responseLBS status200 [] ""+                )+                    `E.catch` \e -> putMVar killed e >> E.throwIO e+        bracket openFreePort (close . snd) $ \(testPort, sock) -> do+            server <- forkIO $ runSettingsSocket defaultSettings sock app+            client <- openConnection testPort+            sendAll client "GET / HTTP/1.1\r\nHost: localhost\r\n\r\n"+            -- The application is in the middle of the request.+            timeout 2_000_000 (takeMVar servingNow) `shouldReturn` Just ()+            killThread server+            timeout 2_000_000 (byManager <$> takeMVar killed) `shouldReturn` Just True+            close client++    it "kills a connection forked but not yet scheduled (#1126)" $ do+        -- The thread records itself, so between the accept loop keeping a+        -- place for it and the thread being scheduled there is nothing to+        -- kill.  A 'settingsFork' which does not schedule at once -- what+        -- the reporter of #1126 sets -- makes the window wide.+        servingNow <- newEmptyMVar+        forked <- newEmptyMVar+        let app _ respond = do+                putMVar servingNow ()+                threadDelay 10_000_000+                respond $ responseLBS status200 [] ""+            set =+                setFork+                    ( \io -> void $ forkIOWithUnmask $ \unmask -> do+                        -- Forked, with its place kept and not yet taken.+                        putMVar forked ()+                        threadDelay 300_000+                        io unmask+                    )+                    defaultSettings+        bracket openFreePort (close . snd) $ \(testPort, sock) -> do+            server <- forkIO $ runSettingsSocket set sock app+            client <- openConnection testPort+            sendAll client "GET / HTTP/1.1\r\nHost: localhost\r\n\r\n"+            timeout 2_000_000 (takeMVar forked) `shouldReturn` Just ()+            killThread server+            timeout 2_000_000 (takeMVar servingNow) `shouldReturn` Nothing+            close client+     it "waits for a connection accepted just before it stopped accepting" $ do         -- The window is between accepting a connection and the thread         -- serving it being scheduled. Delaying the thread makes it wide         -- enough to test; in a running server it is however long the RTS         -- takes to get to the new thread.-        accepted <- newIORef (0 :: Int)+        accepted <- newEmptyMVar+        stopSlot <- newEmptyMVar         closed <- newIORef (0 :: Int)          let slowFork :: ((forall a. IO a -> IO a) -> IO ()) -> IO ()-            slowFork act = void $ forkIOWithUnmask $ \unmask -> do-                threadDelay 200_000-                act unmask--            -- Take one connection, then stop accepting by closing the-            -- listening socket, which is what a graceful shutdown does. The-            -- close happens here rather than from another thread so that it-            -- cannot land while the accept loop is parked inside accept().-            acceptOnlyOne sock = do-                taken <- atomicModifyIORef' accepted $ \n -> (n + 1, n)-                if taken == 0-                    then accept sock-                    else close sock >> accept sock+            slowFork act = do+                -- A connection has been accepted.  Said here, where the+                -- accept loop still is, rather than in the thread below,+                -- which is the one being kept from running.+                void $ tryPutMVar accepted ()+                void $ forkIOWithUnmask $ \unmask -> do+                    threadDelay 200_000+                    act unmask              settings =                 setFork slowFork $-                    setAccept acceptOnlyOne $+                    setInstallShutdownHandler (putMVar stopSlot) $                         setOnClose (\_ -> atomicModifyIORef' closed $ \n -> (n + 1, ())) $                             setGracefulShutdownTimeout (Just 5) $                                 setOnException (\_ _ -> pure ()) defaultSettings@@ -64,6 +115,11 @@             bracket (openConnection testPort) close $ \_ -> pure ()              withAsync (runSettingsSocket settings sock app) $ \server -> do+                stopAccepting <- takeMVar stopSlot+                -- The connection is accepted and the thread serving it is+                -- still parked, which is the window this is about.+                takeMVar accepted+                stopAccepting                 timeout 30_000_000 (wait server)                     >>= maybe (expectationFailure "Timeout waiting for server shutdown") pure                 -- Returning is what lets the process exit, so a connection@@ -139,3 +195,9 @@     connectionRefused = \case         (HttpExceptionRequest _ (ConnectionFailure _)) -> True         _ -> False++-- | Whether the exception is the one the thread manager kills a thread with.+byManager :: E.SomeException -> Bool+byManager e = case E.fromException e of+    Just (KilledByThreadManager _) -> True+    Nothing -> False

@@ -3,7 +3,7 @@ module ServerStateSpec where  import Network.Wai.Handler.Warp (getServerState)-import Network.Wai.Handler.Warp.Counter (increase)+import Network.Wai.Handler.Warp.Counter (Counter, forkConnection) import Network.Wai.Handler.Warp.Settings (     ServerState (..),     currentOpenConnections,@@ -18,6 +18,12 @@ main :: IO () main = hspec spec +-- | One more connection on the counter, through a fork which makes no+--   thread: the place is kept and never taken, which is all these tests+--   ask of the counter.+countOneMore :: Counter -> IO ()+countOneMore counter = forkConnection counter (\_ -> return ()) (\_ -> return ())+ spec :: Spec spec = do     describe "ServerState" $ do@@ -35,9 +41,9 @@                             a <- currentOpenConnections outerSS                             b <- currentOpenConnections innerSS                             (a, b) `shouldBe` (i, i)-                    increase $ serverConnectionCounter outerSS+                    countOneMore $ serverConnectionCounter outerSS                     bothCount 1-                    increase $ serverConnectionCounter innerSS+                    countOneMore $ serverConnectionCounter innerSS                     bothCount 2                     let bothDown bool = do                             a <- currentShuttingDownState outerSS@@ -49,7 +55,7 @@                     bothDown False         it "is idempotent" $ do             let incAndCheck ss i = do-                    increase $ serverConnectionCounter ss+                    countOneMore $ serverConnectionCounter ss                     currentOpenConnections ss `shouldReturn` i             (ss1, set1) <- makeServerState defaultSettings             incAndCheck ss1 1

@@ -1,6 +1,6 @@ cabal-version:      >=1.10 name:               warp-version:            3.4.17+version:            3.4.18 license:            MIT license-file:       LICENSE maintainer:         michael@snoyman.com@@ -110,12 +110,12 @@         http-semantics >=0.4 && <0.5,         http2 >=5.4 && <5.5,         iproute >=1.3.1,-        recv >=0.1.2 && <0.2.0,+        recv >=0.1.3 && <0.2.0,         simple-sendfile >=0.2.7 && <0.3,         stm >=2.3,         streaming-commons >=0.1.10,         text,-        time-manager >=0.2 && <0.6,+        time-manager >=0.5 && <0.6,         vault >=0.3,         wai >=3.2.5 && <3.3,         word8@@ -132,7 +132,7 @@             network-bytestring >=0.1.3 && <0.1.4      else-        build-depends: network >=2.3+        build-depends: network >=3.2.10      if flag(warp-debug)         cpp-options: -DWARP_DEBUG@@ -257,7 +257,7 @@         iproute >=1.3.1,         network,         process,-        recv >=0.1.2 && <0.2.0,+        recv >=0.1.3 && <0.2.0,         simple-sendfile >=0.2.4 && <0.3,         stm >=2.3,         streaming-commons >=0.1.10,