warp 2.1.4 → 2.1.4.1

raw patch · 2 files changed

+37/−19 lines, 2 files

Files

• Network/Wai/Handler/Warp/Response.hs +29/−18
• warp.cabal +8/−1

@@ -57,28 +57,35 @@ -- $setup -- >>> :set -XOverloadedStrings +mapRight :: (b -> c) -> Either a b -> Either a c+mapRight f eith = case eith of+    Right x -> Right (f x)+    Left l -> Left l+ ----------------------------------------------------------------  fileRange :: H.Status -> H.ResponseHeaders -> FilePath            -> Maybe FilePart -> Maybe HeaderValue-          -> IO (Either SomeException+          -> IO (Either IOException                         (H.Status, H.ResponseHeaders, Integer, Integer))-fileRange s0 hs0 path mPart mRange = try $ do-    fileSize <- checkFileSize mPart-    let (beg, end, len, isEntire) = checkPartRange fileSize mPart mRange-    let hs1 = addContentLength len hs0-        hs | isEntire  = hs1-           | otherwise = addContentRange beg end fileSize hs1-        s  | isEntire  = s0-           | otherwise = H.status206-    return (s, hs, beg, len)+fileRange s0 hs0 path mPart mRange =+    mapRight (fileRangeSized . fromIntegral . P.fileSize) <$>+        try (P.getFileStatus path)  where-    checkFileSize Nothing = fromIntegral . P.fileSize <$> P.getFileStatus path-    checkFileSize (Just part) = return $ filePartFileSize part+    fileRangeSized :: Integer -> (H.Status, H.ResponseHeaders, Integer, Integer)+    fileRangeSized fileSize =+        let (beg, end, len, isEntire) = checkPartRange fileSize mPart mRange+            hs1 = addContentLength len hs0+            hs | isEntire  = hs1+               | otherwise = addContentRange beg end fileSize hs1+            s  | isEntire  = s0+               | otherwise = H.status206+        in  (s, hs, beg, len) + checkPartRange :: Integer -> Maybe FilePart -> Maybe HeaderValue                -> (Integer, Integer, Integer, Bool)-checkPartRange fileSize mPart mRange = checkPart mPart mRange+checkPartRange fileSize = checkPart   where     checkPart Nothing Nothing = (0, fileSize - 1, fileSize, True)     checkPart Nothing (Just range) = case parseByteRanges range >>= listToMaybe of@@ -184,10 +191,10 @@         ResponseSource _ _ fb       -> RspSource fb needsChunked th         ResponseRaw raw _           -> RspRaw raw leftover' (T.tickle th)     ret = case response of-        ResponseFile _ _ _ _  -> isPersist-        ResponseBuilder _ _ _ -> isKeepAlive-        ResponseSource _ _ _  -> isKeepAlive-        ResponseRaw _ _       -> False+        ResponseFile    {} -> isPersist+        ResponseBuilder {} -> isKeepAlive+        ResponseSource  {} -> isKeepAlive+        ResponseRaw     {} -> False  ---------------------------------------------------------------- @@ -208,7 +215,11 @@ sendRsp conn ver s0 hs0 restore (RspFile path mPart mRange hook) = restore $ do     ex <- fileRange s0 hs path mPart mRange     case ex of-        Left _ -> sendRsp conn ver s2 hs2 id (RspBuilder body True)+        Left _ex ->+#ifdef WARP_DEBUG+          print _ex >>+#endif+          sendRsp conn ver s2 hs2 id (RspBuilder body True)         Right (s, hs1, beg, len) -> do             lheader <- composeHeader ver s hs1             connSendFile conn path beg len hook [lheader]

@@ -1,5 +1,5 @@ Name:                warp-Version:             2.1.4+Version:             2.1.4.1 Synopsis:            A fast, light-weight web server for WAI applications. License:             MIT License-file:        LICENSE@@ -31,6 +31,10 @@     Description: Allow use of sendfileFd (not available on GNU/kFreeBSD)     Default:     True +Flag warp-debug+    Description: print debug output. not suitable for production+    Default:     False+ Library   Build-Depends:     base                      >= 3        && < 5                    , array@@ -79,6 +83,9 @@                      Network.Wai.Handler.Warp.Types                      Paths_warp   Ghc-Options:       -Wall++  if flag(warp-debug)+      Cpp-Options:   -DWARP_DEBUG   if (os(linux) || os(freebsd) || os(darwin)) && flag(allow-sendfilefd)       Cpp-Options:   -DSENDFILEFD       Build-Depends: hashable