wai-extra 3.0.3.2 → 3.0.4

raw patch · 4 files changed

+77/−1 lines, 4 files

Files

• ChangeLog.md +4/−0
• Network/Wai/Middleware/StreamFile.hs +44/−0
• test/WaiExtraSpec.hs +27/−0
• wai-extra.cabal +2/−1

@@ -1,3 +1,7 @@+## 3.0.4++Add the `StreamFile` middleware.+ ## 3.0.3  Add the `AddHeaders` middleware.

@@ -0,0 +1,44 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+--+-- Since 3.0.4+module Network.Wai.Middleware.StreamFile+    (streamFile) where++import Network.Wai (responseStream)+import Network.Wai.Internal+import Network.Wai (Middleware, responseToStream)+import qualified Data.ByteString.Char8 as S8+import System.Posix++-- |Convert ResponseFile type responses into ResponseStream type+--+-- Checks the response type, and if it's a ResponseFile, converts it+-- into a ResponseStream. Other response types are passed through+-- unchanged.+--+-- Converted responses get a Content-Length header.+--+-- Streaming a file will bypass a sendfile system call, and may be+-- useful to work around systems without working sendfile+-- implementations.+--+-- Since 3.0.4+streamFile :: Middleware+streamFile app env sendResponse = app env $ \res ->+    case res of+      ResponseFile _ _ fp _ -> withBody sendBody+          where+            (s, hs, withBody) = responseToStream res+            sendBody :: StreamingBody -> IO ResponseReceived+            sendBody body = do+               len <- getFileSize fp+               let hs' = ("Content-Length", (S8.pack (show len))) : hs+               sendResponse $ responseStream s hs' body+      _ -> sendResponse res++getFileSize :: FilePath -> IO FileOffset+getFileSize path = do+    stat <- getFileStatus path+    return (fileSize stat)

@@ -25,6 +25,7 @@ import Network.Wai.Middleware.AcceptOverride import Network.Wai.Middleware.RequestLogger import Codec.Compression.GZip (decompress)+import Network.Wai.Middleware.StreamFile  import Control.Monad.IO.Class (liftIO) import Data.Maybe (fromMaybe)@@ -57,6 +58,8 @@     it "method override post" caseMethodOverridePost     it "accept override" caseAcceptOverride     it "debug request body" caseDebugRequestBody+    it "stream file" caseStreamFile+    it "stream LBS" caseStreamLBS  toRequest :: S8.ByteString -> S8.ByteString -> SRequest toRequest ctype content = SRequest defaultRequest@@ -419,3 +422,27 @@   pair4 = makePair "should 404 if none match" $ do     res4 <- get "/api/v3"     assertStatus 404 res4++testFile :: FilePath+testFile = "test/WaiExtraSpec.hs"++streamFileApp :: Application+streamFileApp = streamFile $ \_ f -> f $ responseFile status200 [] testFile Nothing++caseStreamFile :: Assertion+caseStreamFile = flip runSession streamFileApp $ do+    sres <- request defaultRequest+    assertStatus 200 sres+    assertBodyContains "caseStreamFile" sres+    assertNoHeader "Transfer-Encoding" sres++streamLBSApp :: Application+streamLBSApp = streamFile $ \_ f -> f $ responseLBS status200+    [("Content-Type", "text/plain")]+    "test"++caseStreamLBS :: Assertion+caseStreamLBS = flip runSession streamLBSApp $ do+    sres <- request defaultRequest+    assertStatus 200 sres+    assertBody "test" sres

@@ -1,5 +1,5 @@ Name:                wai-extra-Version:             3.0.3.2+Version:             3.0.4 Synopsis:            Provides some basic WAI handlers and middleware. description:         API docs and the README are available at <http://www.stackage.org/package/wai-extra>. License:             MIT@@ -66,6 +66,7 @@                      Network.Wai.Middleware.Rewrite                      Network.Wai.Middleware.Vhost                      Network.Wai.Middleware.HttpAuth+                     Network.Wai.Middleware.StreamFile                      Network.Wai.Parse                      Network.Wai.UrlMap                      Network.Wai.Test