removing unliftio from warp

warp/Network/Wai/Handler/Warp.hs

@@ -141,7 +141,7 @@ module Network.Wai.Handler.Warp (
 
 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

warp/Network/Wai/Handler/Warp/Conduit.hs

@@ -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

warp/Network/Wai/Handler/Warp/FdCache.hs

@@ -26,7 +26,7 @@ import System.Posix.IO (
     openFd,
     setFdOption,
  )
-import UnliftIO.Exception (bracket)
+import Control.Exception (bracket)
 #endif
 import System.Posix.Types (Fd)
 

warp/Network/Wai/Handler/Warp/FileInfoCache.hs

@@ -7,14 +7,14 @@ module Network.Wai.Handler.Warp.FileInfoCache (
     getInfo, -- test purpose only
 ) where
 
+import Control.Exception (bracket, onException, throwIO)
 import Control.Reaper
 import Network.HTTP.Date
 #if WINDOWS
 import System.PosixCompat.Files
 #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 @@ getInfo path = do
                         , 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 :: FileInfoCache -> FilePath -> IO FileInfo
 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 @@ positive reaper path = do
 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 @@ withFileInfoCache
     -> IO a
 withFileInfoCache 0 action = action getInfoNaive
 withFileInfoCache duration action =
-    UnliftIO.bracket
+    bracket
         (initialize duration)
         terminate
         (action . getAndRegisterInfo)

warp/Network/Wai/Handler/Warp/HTTP1.hs

@@ -9,6 +9,7 @@ module Network.Wai.Handler.Warp.HTTP1 (
 ) 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.Socket (SockAddr (SockAddrInet, SockAddrInet6))
 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 @@ http1server
     -> 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 @@ http1server settings ii conn transport app addr th istatus src =
                 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 @@ http1server settings ii conn transport app addr th istatus src =
         -- 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 @@ processRequest settings ii conn app th istatus src req mremainingRef idxhdr next
     -- 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 @@ processRequest settings ii conn app th istatus src req mremainingRef idxhdr next
         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

warp/Network/Wai/Handler/Warp/HTTP2.hs

@@ -9,6 +9,7 @@ module Network.Wai.Handler.Warp.HTTP2 (
     http2server,
 ) where
 
+import qualified Control.Exception as E
 import qualified Data.ByteString as BS
 import Data.IORef (readIORef)
 import qualified Data.IORef as I
@@ -20,7 +21,6 @@ import Network.Socket.BufferPool
 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
@@ -93,7 +93,7 @@ http2server label settings ii transport addr app h2req0 aux0 response = do
     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)
@@ -105,7 +105,12 @@ http2server label settings ii transport addr app h2req0 aux0 response = do
             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
@@ -135,7 +140,7 @@ http2server label settings ii transport addr app h2req0 aux0 response = do
 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
@@ -146,7 +151,7 @@ wrappedRecvN th slowlorisSize readN bufsize = do
         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

warp/Network/Wai/Handler/Warp/HTTP2/PushPromise.hs

@@ -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 @@ fromPushPromises ii req = do
 
 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

warp/Network/Wai/Handler/Warp/HTTP2/Response.hs

@@ -6,13 +6,13 @@ module Network.Wai.Handler.Warp.HTTP2.Response (
     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 @@ responseFile st rsphdr method path (Just fp) _ _ =
     !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

warp/Network/Wai/Handler/Warp/Request.hs

@@ -27,7 +27,7 @@ import Data.Word8 (_cr, _lf)
 #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

warp/Network/Wai/Handler/Warp/RequestHeader.hs

@@ -13,7 +13,7 @@ import Foreign.ForeignPtr (withForeignPtr)
 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

warp/Network/Wai/Handler/Warp/Response.hs

@@ -14,6 +14,7 @@ module Network.Wai.Handler.Warp.Response (
     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
 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 @@ sendRsp conn ii th ver s0 hs0 rspidxhdr maxRspBufSize method (RspFile path (Just
 -- 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