git.iko.soy/typeable/wai
on master help sign in
responseToStream test suite
commit81b45e467663df1de1a71a65e879ae544e50621b authorMichael Snoyman <michael@snoyman.com> dateThu 22 May 2014, 10:04 (12 years ago) parent447cd4a
4 files changed+88−12
compare with master
unifiedsplit
wai/Network/Wai.hs+14−11 wai/test/Network/WaiSpec.hs+55 wai/test/Spec.hs+1 wai/wai.cabal+18−1
wai/Network/Wai.hs+14−11
@@ -1,6 +1,5 @@
11{-# LANGUAGE Rank2Types #-}
22{-# LANGUAGE CPP #-}
3−{-# LANGUAGE ImpredicativeTypes #-}
43{-|
54
65This module defines a generic web application interface. It is a common
@@ -78,7 +77,6 @@ module Network.Wai
7877
7978import Blaze.ByteString.Builder (Builder, fromLazyByteString)
8079import Blaze.ByteString.Builder (fromByteString)
81−import Control.Exception (bracket, bracketOnError)
8280import Control.Monad (unless)
8381import qualified Data.ByteString as B
8482import qualified Data.ByteString.Lazy as L
@@ -171,12 +169,23 @@ responseHeaders (ResponseRaw _ res) = responseHeaders res
171169responseToStream :: Response
172170 -> ( H.Status
173171 , H.ResponseHeaders
174− , forall a. (StreamingBody -> IO a) -> IO a
172+ , (StreamingBody -> IO a) -> IO a
175173 )
176174responseToStream (ResponseStream s h b) = (s, h, ($ b))
177175responseToStream (ResponseFile s h fp (Just part)) =
178− error "FIXME responseToStream"
179− --(s, h, \f -> IO.withFile fp IO.ReadMode $ \handle -> f $ sourceFilePart handle part C.$= CL.map (C.Chunk . fromByteString))
176+ ( s
177+ , h
178+ , \withBody -> IO.withFile fp IO.ReadMode $ \handle -> withBody $ \sendChunk _flush -> do
179+ IO.hSeek handle IO.AbsoluteSeek $ filePartOffset part
180+ let loop remaining | remaining <= 0 = return ()
181+ loop remaining = do
182+ bs <- B.hGetSome handle defaultChunkSize
183+ unless (B.null bs) $ do
184+ let x = B.take remaining bs
185+ sendChunk $ fromByteString x
186+ loop $ remaining - B.length x
187+ loop $ fromIntegral $ filePartByteCount part
188+ )
180189responseToStream (ResponseFile s h fp Nothing) =
181190 ( s
182191 , h
@@ -191,12 +200,6 @@ responseToStream (ResponseBuilder s h b) =
191200 (s, h, \withBody -> withBody $ \sendChunk _flush -> sendChunk b)
192201responseToStream (ResponseRaw _ res) = responseToStream res
193202
194−{- FIXME
195−sourceFilePart :: IO.Handle -> FilePart -> C.Source IO B.ByteString
196−sourceFilePart handle (FilePart offset count _) =
197− CB.sourceHandleRange handle (Just offset) (Just count)
198−-}
199−
200203----------------------------------------------------------------
201204
202205-- | The WAI application.
wai/test/Network/WaiSpec.hsnew file+55
@@ -0,0 +1,55 @@
1+module Network.WaiSpec (spec) where
2+
3+import Test.Hspec
4+import Test.Hspec.QuickCheck (prop)
5+import Network.Wai
6+import Data.IORef
7+import Data.Monoid
8+import qualified Data.ByteString as S
9+import qualified Data.ByteString.Lazy as L
10+import Blaze.ByteString.Builder (toByteString, Builder, fromWord8)
11+import Control.Monad (forM_)
12+
13+spec :: Spec
14+spec = do
15+ describe "responseToStream" $ do
16+ let getBody res = do
17+ let (_, _, f) = responseToStream res
18+ f $ \streamingBody -> do
19+ builderRef <- newIORef mempty
20+ let add :: Builder -> IO ()
21+ add b = atomicModifyIORef builderRef $ \builder ->
22+ (builder `mappend` b, ())
23+ flush :: IO ()
24+ flush = return ()
25+ streamingBody add flush
26+ fmap toByteString $ readIORef builderRef
27+ prop "responseLBS" $ \bytes -> do
28+ body <- getBody $ responseLBS undefined undefined $ L.pack bytes
29+ body `shouldBe` S.pack bytes
30+ prop "responseBuilder" $ \bytes -> do
31+ body <- getBody $ responseBuilder undefined undefined
32+ $ mconcat $ map fromWord8 bytes
33+ body `shouldBe` S.pack bytes
34+ prop "responseStream" $ \chunks -> do
35+ body <- getBody $ responseStream undefined undefined $ \sendChunk _ ->
36+ forM_ chunks $ \chunk -> sendChunk $ mconcat $ map fromWord8 chunk
37+ body `shouldBe` S.concat (map S.pack chunks)
38+ it "responseFile total" $ do
39+ let fp = "wai.cabal"
40+ body <- getBody $ responseFile undefined undefined fp Nothing
41+ expected <- S.readFile fp
42+ body `shouldBe` expected
43+ prop "responseFile partial" $ \offset' count' -> do
44+ let fp = "wai.cabal"
45+ totalBS <- S.readFile fp
46+ let total = S.length totalBS
47+ offset = abs offset' `mod` total
48+ count = abs count' `mod` (total - offset)
49+ body <- getBody $ responseFile undefined undefined fp $ Just FilePart
50+ { filePartOffset = fromIntegral offset
51+ , filePartByteCount = fromIntegral count
52+ , filePartFileSize = fromIntegral total
53+ }
54+ let expected = S.take count $ S.drop offset totalBS
55+ body `shouldBe` expected
wai/test/Spec.hsnew file+1
@@ -0,0 +1 @@
1+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
wai/wai.cabal+18−1
@@ -9,7 +9,7 @@ Maintainer: michael@snoyman.com
99Homepage: https://github.com/yesodweb/wai
1010Category: Web
1111Build-Type: Simple
12−Cabal-Version: >=1.6
12+Cabal-Version: >=1.8
1313Stability: Stable
1414
1515Source-repository head
@@ -28,3 +28,20 @@ Library
2828 Exposed-modules: Network.Wai
2929 Network.Wai.Internal
3030 ghc-options: -Wall
31+
32+test-suite test
33+ hs-source-dirs: test
34+ main-is: Spec.hs
35+ type: exitcode-stdio-1.0
36+ ghc-options: -threaded
37+ cpp-options: -DTEST
38+ build-depends: base
39+ , wai
40+ , hspec
41+ , blaze-builder
42+ , bytestring
43+ other-modules: Network.WaiSpec
44+
45+source-repository head
46+ type: git
47+ location: git://github.com/yesodweb/wai.git