warp 3.1.10 → 3.1.11
raw patch · 6 files changed
+50/−59 lines, 6 filesdep ~auto-update
Dependency ranges changed: auto-update
Files
- Network/Wai/Handler/Warp/Date.hs +2/−2
- Network/Wai/Handler/Warp/File.hs +1/−3
- Network/Wai/Handler/Warp/HTTP2.hs +1/−1
- Network/Wai/Handler/Warp/HTTP2/Request.hs +12/−4
- Network/Wai/Handler/Warp/Timeout.hs +30/−45
- warp.cabal +4/−4
Network/Wai/Handler/Warp/Date.hs view
@@ -18,8 +18,8 @@ import Network.HTTP.Date #if WINDOWS-import Data.Time (UTCTime, formatTime, getCurrentTime)-import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)+import Data.Time (UTCTime, getCurrentTime)+import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) import Foreign.C.Types (CTime(..)) #else import System.Posix (epochTime)
Network/Wai/Handler/Warp/File.hs view
@@ -12,9 +12,7 @@ import Data.Array ((!)) import Data.ByteString (ByteString) import qualified Data.ByteString as B hiding (pack)-import qualified Data.ByteString.Builder as B import qualified Data.ByteString.Char8 as B (pack, readInteger)-import qualified Data.ByteString.Lazy as L import Network.HTTP.Date import qualified Network.HTTP.Types as H import qualified Network.HTTP.Types.Header as H@@ -163,7 +161,7 @@ addContentHeaders hs off len size = hs'' where contentRange = contentRangeHeader off (off + len - 1) size- lengthBS = L.toStrict $ B.toLazyByteString $ B.integerDec len+ !lengthBS = B.pack $ show len hs' = (H.hContentLength, lengthBS):( #if MIN_VERSION_http_types(0,9,0) H.hAcceptRanges
Network/Wai/Handler/Warp/HTTP2.hs view
@@ -38,7 +38,7 @@ -- fixme: hard coding: 10 replicateM_ 10 $ spawnAction mgr -- Receiver- let mkreq = mkRequest settings addr+ let mkreq = mkRequest ii settings addr tid <- forkIO $ frameReceiver ctx mkreq readN -- Sender -- frameSender is the main thread because it ensures to send
Network/Wai/Handler/Warp/HTTP2/Request.hs view
@@ -19,6 +19,7 @@ import Data.CaseInsensitive (mk) import Data.IORef (IORef, readIORef, newIORef, writeIORef) import Data.Maybe (isJust)+import qualified Data.Vault.Lazy as Vault #if __GLASGOW_HASKELL__ < 709 import Data.Monoid (mempty) #endif@@ -28,10 +29,13 @@ import qualified Network.HTTP.Types as H import Network.Socket (SockAddr) import Network.Wai+import Network.Wai.Internal (Request(..)) import Network.Wai.Handler.Warp.HTTP2.Types import Network.Wai.Handler.Warp.ReadInt+import Network.Wai.Handler.Warp.Request (pauseTimeoutKey, getFileInfoKey)+import Network.Wai.Handler.Warp.Types (InternalInfo(..)) import qualified Network.Wai.Handler.Warp.Settings as S (Settings, settingsNoParsePath)-import Network.Wai.Internal (Request(..))+import qualified Network.Wai.Handler.Warp.Timeout as Timeout data ValidHeaders = ValidHeaders { vhMethod :: ByteString@@ -43,8 +47,8 @@ type MkReq = ValidHeaders -> IO ByteString -> Request -mkRequest :: S.Settings -> SockAddr -> MkReq-mkRequest settings addr (ValidHeaders m p ma _ hdr) body = req+mkRequest :: InternalInfo -> S.Settings -> SockAddr -> MkReq+mkRequest ii settings addr (ValidHeaders m p ma _ hdr) body = req where (unparsedPath,query) = B8.break (=='?') p path = H.extractPath unparsedPath@@ -61,11 +65,15 @@ , isSecure = True , remoteHost = addr , requestBody = body- , vault = mempty+ , vault = vaultValue , requestBodyLength = ChunkedBody -- fixme , requestHeaderHost = ma , requestHeaderRange = lookup hRange hdr }+ th = threadHandle ii+ vaultValue = Vault.insert pauseTimeoutKey (Timeout.pause th)+ $ Vault.insert getFileInfoKey (fileInfo ii)+ Vault.empty ----------------------------------------------------------------
Network/Wai/Handler/Warp/Timeout.hs view
@@ -1,7 +1,4 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE MagicHash #-}-{-# LANGUAGE UnboxedTuples #-} -- for GHC 7.4 or earlier module Network.Wai.Handler.Warp.Timeout ( -- ** Types@@ -11,6 +8,7 @@ -- ** Manager , initialize , stopManager+ , killManager , withManager -- ** Registration , register@@ -24,25 +22,12 @@ , TimeoutThread (..) ) where -#ifndef MIN_VERSION_base-#define MIN_VERSION_base(x,y,z) 1-#endif--#if MIN_VERSION_base(4,6,0)-import Control.Concurrent (mkWeakThreadId, ThreadId)-#else-import GHC.Conc (ThreadId(..))-import GHC.Exts (mkWeak#)-import GHC.IO (IO (IO))-#endif import Control.Concurrent (myThreadId) import qualified Control.Exception as E-import GHC.Weak (Weak (..))+import Control.Reaper+import Data.Typeable (Typeable) import Network.Wai.Handler.Warp.IORef (IORef) import qualified Network.Wai.Handler.Warp.IORef as I-import System.Mem.Weak (deRefWeak)-import Data.Typeable (Typeable)-import Control.Reaper ---------------------------------------------------------------- @@ -53,7 +38,7 @@ type TimeoutAction = IO () -- | A handle used by 'Manager'-data Handle = Handle TimeoutAction (IORef State)+data Handle = Handle !(IORef TimeoutAction) !(IORef State) data State = Active -- Manager turns it to Inactive. | Inactive -- Manager removes it with timeout action.@@ -70,10 +55,11 @@ , reaperDelay = timeout } where- prune m@(Handle onTimeout iactive) = do- state <- I.atomicModifyIORef' iactive (\x -> (inactivate x, x))+ prune m@(Handle actionRef stateRef) = do+ state <- I.atomicModifyIORef' stateRef (\x -> (inactivate x, x)) case state of Inactive -> do+ onTimeout <- I.readIORef actionRef onTimeout `E.catch` ignoreAll return Nothing Canceled -> return Nothing@@ -84,38 +70,42 @@ ---------------------------------------------------------------- --- | Stopping timeout manager.+-- | Stopping timeout manager with onTimeout fired. stopManager :: Manager -> IO () stopManager mgr = E.mask_ (reaperStop mgr >>= mapM_ fire) where- fire (Handle onTimeout _) = onTimeout `E.catch` ignoreAll+ fire (Handle actionRef _) = do+ onTimeout <- I.readIORef actionRef+ onTimeout `E.catch` ignoreAll ignoreAll :: E.SomeException -> IO () ignoreAll _ = return () +-- | Killing timeout manager immediately without firing onTimeout.+killManager :: Manager -> IO ()+killManager = reaperKill+ ---------------------------------------------------------------- -- | Registering a timeout action. register :: Manager -> TimeoutAction -> IO Handle register mgr onTimeout = do- iactive <- I.newIORef Active- let h = Handle onTimeout iactive+ actionRef <- I.newIORef onTimeout+ stateRef <- I.newIORef Active+ let h = Handle actionRef stateRef reaperAdd mgr h return h -- | Registering a timeout action of killing this thread. registerKillThread :: Manager -> IO Handle registerKillThread m = do- wtid <- myThreadId >>= mkWeakThreadId- register m $ killIfExist wtid---- If ThreadId is hold referred by a strong reference,--- it leaks even after the thread is killed.--- So, let's use a weak reference so that CG can throw ThreadId away.--- deRefWeak checks if ThreadId referenced by the weak reference--- exists. If exists, it means that the thread is alive.-killIfExist :: Weak ThreadId -> TimeoutAction-killIfExist wtid = deRefWeak wtid >>= maybe (return ()) (`E.throwTo` TimeoutThread)+ -- If we hold ThreadId, the stack and data of the thread is leaked.+ -- If we hold Weak ThreadId, the stack is released. However, its+ -- data is still leaked probably because of a bug of GHC.+ -- So, let's just use ThreadId and release ThreadId by+ -- overriding the timeout action by "cancel".+ tid <- myThreadId+ register m $ E.throwTo tid TimeoutThread data TimeoutThread = TimeoutThread deriving Typeable@@ -123,29 +113,24 @@ instance Show TimeoutThread where show TimeoutThread = "Thread killed by Warp's timeout reaper" -#if !MIN_VERSION_base(4,6,0)-mkWeakThreadId :: ThreadId -> IO (Weak ThreadId)-mkWeakThreadId t@(ThreadId t#) = IO $ \s ->- case mkWeak# t# t Nothing s of- (# s1, w #) -> (# s1, Weak w #)-#endif- ---------------------------------------------------------------- -- | Setting the state to active. -- 'Manager' turns active to inactive repeatedly. tickle :: Handle -> IO ()-tickle (Handle _ iactive) = I.writeIORef iactive Active+tickle (Handle _ stateRef) = I.writeIORef stateRef Active -- | Setting the state to canceled. -- 'Manager' eventually removes this without timeout action. cancel :: Handle -> IO ()-cancel (Handle _ iactive) = I.writeIORef iactive Canceled+cancel (Handle actionRef stateRef) = do+ I.writeIORef actionRef (return ()) -- ensuring to release ThreadId+ I.writeIORef stateRef Canceled -- | Setting the state to paused. -- 'Manager' does not change the value. pause :: Handle -> IO ()-pause (Handle _ iactive) = I.writeIORef iactive Paused+pause (Handle _ stateRef) = I.writeIORef stateRef Paused -- | Setting the paused state to active. -- This is an alias to 'tickle'.
warp.cabal view
@@ -1,5 +1,5 @@ Name: warp-Version: 3.1.10+Version: 3.1.11 Synopsis: A fast, light-weight web server for WAI applications. License: MIT License-file: LICENSE@@ -43,7 +43,7 @@ , ghc-prim , http-types >= 0.8.5 , iproute >= 1.3.1- , http2 >= 1.3+ , http2 >= 1.3 && < 1.4 , simple-sendfile >= 0.2.7 && < 0.3 , unix-compat >= 0.2 , wai >= 3.0.4 && < 3.1@@ -54,6 +54,7 @@ , word8 , hashable , unordered-containers+ , http-date if flag(network-bytestring) Build-Depends: network >= 2.2.1.5 && < 2.2.3 , network-bytestring >= 0.1.3 && < 0.1.4@@ -104,7 +105,6 @@ Build-Depends: time else Build-Depends: unix- , http-date Other-modules: Network.Wai.Handler.Warp.MultiMap Test-Suite doctest@@ -167,11 +167,11 @@ , word8 , hashable , unordered-containers+ , http-date if (os(linux) || os(freebsd) || os(darwin)) && flag(allow-sendfilefd) Cpp-Options: -DSENDFILEFD Build-Depends: unix- , http-date if os(windows) Cpp-Options: -DWINDOWS