warp 1.3.2 → 1.3.3
raw patch · 6 files changed
+54/−28 lines, 6 filesnew-uploader
Files
- Network/Wai/Handler/Warp.hs +1/−0
- Network/Wai/Handler/Warp/Conduit.hs +5/−1
- Network/Wai/Handler/Warp/Run.hs +27/−14
- Network/Wai/Handler/Warp/Settings.hs +7/−1
- Network/Wai/Handler/Warp/Types.hs +5/−5
- warp.cabal +9/−7
Network/Wai/Handler/Warp.hs view
@@ -32,6 +32,7 @@ , settingsIntercept , settingsManager , settingsFdCacheDuration+ , settingsResourceTPerRequest -- ** Data types , HostPreference (..) -- * Connection
Network/Wai/Handler/Warp/Conduit.hs view
@@ -6,7 +6,9 @@ import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Trans.Class (lift) import Data.ByteString (ByteString)+import Data.ByteString.Lazy.Char8 (pack) import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L import Data.Conduit import qualified Data.Conduit.Binary as CB import Data.Conduit.Internal (ResumableSource (..))@@ -95,7 +97,9 @@ go src NeedLenNewline = go' src (CB.take 2 >>) go src (HaveLen 0) = do -- Drop the final CRLF- (src', ()) <- lift $ src $$++ CB.drop 2+ (src', ()) <- lift $ src $$++ do+ crlf <- CB.take 2+ unless (crlf == pack "\r\n") $ leftover $ S.concat $ L.toChunks crlf liftIO $ I.writeIORef ipair (src', HaveLen 0) go src (HaveLen len) = do (src', mbs) <- lift $ src $$++ CL.head
Network/Wai/Handler/Warp/Run.hs view
@@ -8,6 +8,7 @@ import Control.Exception import Control.Monad (forever, when, unless, void) import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans.Class (lift) import Data.ByteString (ByteString) import qualified Data.ByteString as S import Data.Conduit@@ -40,7 +41,10 @@ #if WINDOWS import qualified Control.Concurrent.MVar as MV import Network.Socket (withSocketsDo)-#else+#endif++#if SENDFILEFD+import Control.Applicative import qualified Network.Wai.Handler.Warp.FdCache as F #endif @@ -67,13 +71,15 @@ } sendFile :: Socket -> FilePath -> Integer -> Integer -> IO () -> [ByteString] -> Cleaner -> IO ()-#if WINDOWS+#if SENDFILEFD+sendFile s path off len act hdr cleaner = case fdCacher cleaner of+ Nothing -> sendfileWithHeader s path (PartOfFile off len) act hdr+ Just fdc -> do+ (fd, fresher) <- F.getFd fdc path+ sendfileFdWithHeader s fd (PartOfFile off len) (act>>fresher) hdr+#else sendFile s path off len act hdr _ = sendfileWithHeader s path (PartOfFile off len) act hdr-#else-sendFile s path off len act hdr cleaner = do- (fd, fresher) <- F.getFd (fdCacher cleaner) path- sendfileFdWithHeader s fd (PartOfFile off len) (act>>fresher) hdr #endif #if __GLASGOW_HASKELL__ < 702@@ -125,18 +131,21 @@ runSettingsConnection set getConn app = do tm <- maybe (T.initialize $ settingsTimeout set * 1000000) return $ settingsManager set-#if !WINDOWS- fc <- F.initialize (settingsFdCacheDuration set * 1000000)+#if SENDFILEFD+ let duration = settingsFdCacheDuration set+ fc <- case duration of+ 0 -> return Nothing+ _ -> Just <$> F.initialize (duration * 1000000) #endif mask $ \restore -> forever $ do allowInterrupt (conn, addr) <- getConnLoop void . forkIO $ do th <- T.registerKillThread tm-#if WINDOWS- let cleaner = Cleaner th-#else+#if SENDFILEFD let cleaner = Cleaner th fc+#else+ let cleaner = Cleaner th #endif let serve = do onOpen@@ -163,6 +172,9 @@ serveConnection settings cleaner port app conn remoteHost' = runResourceT serveConnection' where+ innerRunResourceT+ | settingsResourceTPerRequest settings = lift . runResourceT+ | otherwise = id th = threadHandle cleaner serveConnection' :: ResourceT IO ()@@ -174,10 +186,11 @@ Nothing -> do -- Let the application run for as long as it wants liftIO $ T.pause th- res <- app env+ keepAlive <- innerRunResourceT $ do+ res <- app env - liftIO $ T.resume th- keepAlive <- sendResponse cleaner env conn res+ liftIO $ T.resume th+ sendResponse cleaner env conn res -- flush the rest of the request body requestBody env $$ CL.sinkNull
Network/Wai/Handler/Warp/Settings.hs view
@@ -25,7 +25,12 @@ , settingsTimeout :: Int -- ^ Timeout value in seconds. Default value: 30 , settingsIntercept :: Request -> Maybe (Source (ResourceT IO) S.ByteString -> Connection -> ResourceT IO ()) , settingsManager :: Maybe Manager -- ^ Use an existing timeout manager instead of spawning a new one. If used, 'settingsTimeout' is ignored. Default is 'Nothing'- , settingsFdCacheDuration :: Int -- ^ Cache duratoin time of file descriptors in seconds. Default value: 10+ , settingsFdCacheDuration :: Int -- ^ Cache duratoin time of file descriptors in seconds. 0 means that the cache mechanism is not used. Default value: 10+ , settingsResourceTPerRequest :: Bool+ -- ^ If @True@, each request\/response pair will run in a separate+ -- @ResourceT@. This provides more intuitive behavior for dynamic code,+ -- but can hinder performance in high-throughput cases. File servers can+ -- safely set to @False@ for increased performance. Default is @True@. } -- | The default settings for the Warp server. See the individual settings for@@ -46,6 +51,7 @@ , settingsIntercept = const Nothing , settingsManager = Nothing , settingsFdCacheDuration = 10+ , settingsResourceTPerRequest = True } where go :: InvalidRequest -> IO ()
Network/Wai/Handler/Warp/Types.hs view
@@ -11,7 +11,7 @@ import Network.HTTP.Types.Header import qualified Paths_warp import qualified Network.Wai.Handler.Warp.Timeout as T-#if !WINDOWS+#if SENDFILEFD import qualified Network.Wai.Handler.Warp.FdCache as F #endif @@ -78,11 +78,11 @@ ---------------------------------------------------------------- -#if WINDOWS-newtype Cleaner = Cleaner { threadHandle :: T.Handle }-#else+#if SENDFILEFD data Cleaner = Cleaner { threadHandle :: T.Handle- , fdCacher :: F.MutableFdCache+ , fdCacher :: Maybe F.MutableFdCache }+#else+newtype Cleaner = Cleaner { threadHandle :: T.Handle } #endif
warp.cabal view
@@ -1,5 +1,5 @@ Name: warp-Version: 1.3.2+Version: 1.3.3 Synopsis: A fast, light-weight web server for WAI applications. License: MIT License-file: LICENSE@@ -48,13 +48,14 @@ Network.Wai.Handler.Warp.Types Paths_warp Ghc-Options: -Wall- if os(windows)- Cpp-options: -DWINDOWS- else+ if os(linux) || os(freebsd) || os(darwin)+ Cpp-Options: -DSENDFILEFD Build-Depends: unix , hashable Other-modules: Network.Wai.Handler.Warp.FdCache Network.Wai.Handler.Warp.MultiMap+ if os(windows)+ Cpp-Options: -DWINDOWS Test-Suite spec Main-Is: Spec.hs@@ -81,11 +82,12 @@ , HUnit , QuickCheck , hspec == 1.3.*- if os(windows)- Cpp-options: -DWINDOWS- else+ if os(linux) || os(freebsd) || os(darwin)+ Cpp-Options: -DSENDFILEFD Build-Depends: unix , hashable+ if os(windows)+ Cpp-Options: -DWINDOWS Source-Repository head Type: git