Permalink
Browse files

Add a 'noCompression' function to the gzip utilities.

  • Loading branch information...
1 parent 53b8d6c commit ef43c1d0692f7496b5675dab3fb22fa9d305f585 @gregorycollins gregorycollins committed Oct 12, 2011
Showing with 31 additions and 1 deletion.
  1. +9 −1 src/Snap/Util/GZip.hs
  2. +22 −0 test/suite/Snap/Util/GZip/Tests.hs
View
@@ -6,7 +6,8 @@
module Snap.Util.GZip
( withCompression
-, withCompression' ) where
+, withCompression'
+, noCompression ) where
import Blaze.ByteString.Builder
import qualified Codec.Zlib.Enum as Z
@@ -123,6 +124,13 @@ withCompression' mimeTable action = do
------------------------------------------------------------------------------
+-- | Turn off compression by setting \"Content-Encoding: identity\" in the
+-- response headers.
+noCompression :: MonadSnap m => m ()
+noCompression = modifyResponse $ setHeader "Content-Encoding" "identity"
+
+
+------------------------------------------------------------------------------
-- private following
------------------------------------------------------------------------------
@@ -50,6 +50,7 @@ tests = [ testIdentity1
, testNopWhenContentEncodingSet
, testCompositionDoesn'tExplode
, testGzipLotsaChunks
+ , testNoCompression
, testBadHeaders ]
@@ -401,3 +402,24 @@ testGzipLotsaChunks = testCase "gzip/lotsOfChunks" prop
frobnicate s = let s' = encode $ md5 $ L.fromChunks [s]
in (s:frobnicate s')
+
+------------------------------------------------------------------------------
+testNoCompression :: Test
+testNoCompression = testProperty "gzip/noCompression" $
+ monadicIO $ forAllM arbitrary prop
+ where
+ prop :: L.ByteString -> PropertyM IO ()
+ prop s = do
+ (!_,!rsp) <- liftQ $ goGZip (seqSnap $ withCompression $
+ (noCompression >> textPlain s))
+ assert $ getHeader "Content-Encoding" rsp == Just "identity"
+ let body = rspBodyToEnum $ rspBody rsp
+
+ s1 <- liftQ $
+ runIteratee stream2stream >>= run_ . body
+
+ assert $ s == s1
+
+
+
+

0 comments on commit ef43c1d

Please sign in to comment.