git.iko.soy/typeable/wai
on master help sign in
Fix lazyRequestBody
commit2e0fa5e2cc877640fd49ff8735c7d49a08320a5f authorMichael Snoyman <michael@snoyman.com> dateThu 22 May 2014, 10:49 (12 years ago) parente67d64c
2 files changed+30−1
compare with master
unifiedsplit
wai/Network/Wai.hs+12−1 wai/test/Network/WaiSpec.hs+18
wai/Network/Wai.hs+12−1
@@ -80,6 +80,7 @@ import Blaze.ByteString.Builder (fromByteString)
8080import Control.Monad (unless)
8181import qualified Data.ByteString as B
8282import qualified Data.ByteString.Lazy as L
83+import qualified Data.ByteString.Lazy.Internal as LI
8384import Data.ByteString.Lazy.Internal (defaultChunkSize)
8485import Data.ByteString.Lazy.Char8 ()
8586import Data.Function (fix)
@@ -88,6 +89,7 @@ import qualified Network.HTTP.Types as H
8889import Network.Socket (SockAddr (SockAddrInet))
8990import Network.Wai.Internal
9091import qualified System.IO as IO
92+import System.IO.Unsafe (unsafeInterleaveIO)
9193
9294----------------------------------------------------------------
9395
@@ -247,4 +249,13 @@ defaultRequest = Request
247249--
248250-- Since 1.4.1
249251lazyRequestBody :: Request -> IO L.ByteString
250−lazyRequestBody = error "lazyRequestBody" -- fmap L.fromChunks . lazyConsume . requestBody
252+lazyRequestBody req =
253+ loop
254+ where
255+ loop = unsafeInterleaveIO $ do
256+ bs <- requestBody req
257+ if B.null bs
258+ then return LI.Empty
259+ else do
260+ bss <- loop
261+ return $ LI.Chunk bs bss
wai/test/Network/WaiSpec.hs+18
@@ -3,6 +3,7 @@ module Network.WaiSpec (spec) where
33import Test.Hspec
44import Test.Hspec.QuickCheck (prop)
55import Network.Wai
6+import Network.Wai.Internal (Request (Request))
67import Data.IORef
78import Data.Monoid
89import qualified Data.ByteString as S
@@ -53,3 +54,20 @@ spec = do
5354 }
5455 let expected = S.take count $ S.drop offset totalBS
5556 body `shouldBe` expected
57+ describe "lazyRequestBody" $ do
58+ prop "works" $ \chunks -> do
59+ ref <- newIORef $ map S.pack $ filter (not . null) chunks
60+ let req = Request
61+ { requestBody = atomicModifyIORef ref $ \bss ->
62+ case bss of
63+ [] -> ([], S.empty)
64+ x:y -> (y, x)
65+ }
66+ body <- lazyRequestBody req
67+ body `shouldBe` L.fromChunks (map S.pack chunks)
68+ it "is lazy" $ do
69+ let req = Request
70+ { requestBody = error "requestBody"
71+ }
72+ _ <- lazyRequestBody req
73+ return ()