snap-core 1.0.0.0 → 1.0.1.0

raw patch · 4 files changed

+31/−19 lines, 4 filesdep ~basedep ~vectorPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, vector

API changes (from Hackage documentation)

Files

• snap-core.cabal +2/−1
• src/Snap/Util/GZip.hs +1/−0
• test/Snap/Util/FileUploads/Tests.hs +27/−18
• test/data/fileServe/mydir2/dir/foo.txt +1/−0

@@ -1,5 +1,5 @@ name:           snap-core-version:        1.0.0.0+version:        1.0.1.0 synopsis:       Snap: A Haskell Web Framework (core interfaces and types)  description:@@ -55,6 +55,7 @@   test/data/fileServe/foo.html,   test/data/fileServe/foo.txt,   test/data/fileServe/mydir1/index.txt,+  test/data/fileServe/mydir2/dir/foo.txt,   test/data/fileServe/mydir2/foo.txt,   test/data/fileServe/mydir3/altindex.html,   test/Snap/Core/Tests.hs,

@@ -13,6 +13,7 @@   , withCompression'   , noCompression   , BadAcceptEncodingException+  , compressibleMimeTypes   ) where  import           Control.Applicative              (Alternative ((<|>), many), Applicative ((*>), (<*), pure), (<$>))

@@ -10,8 +10,8 @@ import           Control.Applicative            (Alternative ((<|>))) import           Control.DeepSeq                (deepseq) import           Control.Exception              (ErrorCall (..), evaluate, throwIO)-import           Control.Exception.Lifted       (Exception (fromException, toException), Handler (Handler), catch, catches, finally, throw)-import           Control.Monad                  (Monad ((>>=), (>>), return), liftM, void)+import           Control.Exception.Lifted       (Exception (fromException, toException), catch, finally, throw)+import           Control.Monad                  (Monad (return, (>>), (>>=)), liftM, void) import           Control.Monad.IO.Class         (MonadIO (liftIO)) import           Data.ByteString                (ByteString) import qualified Data.ByteString.Char8          as S@@ -35,7 +35,7 @@ import           System.Timeout                 (timeout) import           Test.Framework                 (Test) import           Test.Framework.Providers.HUnit (testCase)-import           Test.HUnit                     (assertBool, assertEqual)+import           Test.HUnit                     (assertBool, assertEqual, assertFailure) ------------------------------------------------------------------------------  @@ -273,13 +273,13 @@ ------------------------------------------------------------------------------ testNoFileNameTooBig :: Test testNoFileNameTooBig = testCase "fileUploads/noFileNameTooBig" $-                       (harness tmpdir hndl noFileNameTestBody `catch` h)+                       assertThrows (harness tmpdir hndl noFileNameTestBody) h   where     h !(e :: FileUploadException) = do         let r = fileUploadExceptionReason e         assertBool "correct exception"-                   (T.isInfixOf "form input" r &&-                    T.isInfixOf "exceeded maximum permissible" r)+                   (T.isInfixOf "File" r &&+                    T.isInfixOf "exceeded maximum allowable size" r)      tmpdir = "tempdir_noname_toobig" @@ -292,12 +292,14 @@         coverShowInstance x         assertEqual "filename" Nothing $ partFileName pinfo         assertEqual "disposition" DispositionFile $ partDisposition pinfo+        throwIO x   ------------------------------------------------------------------------------ testFormSizePolicyViolation :: Test-testFormSizePolicyViolation = testCase "fileUploads/formSizePolicy" $-                              (harness tmpdir hndl mixedTestBody `catch` h)+testFormSizePolicyViolation =+    testCase "fileUploads/formSizePolicy" $+    assertThrows (harness tmpdir hndl mixedTestBody) h   where     h !(e :: FileUploadException) = do         let r = fileUploadExceptionReason e@@ -318,8 +320,9 @@  ------------------------------------------------------------------------------ testFormInputsPolicyViolation :: Test-testFormInputsPolicyViolation = testCase "fileUploads/formInputsPolicy" $-                                (harness tmpdir hndl mixedTestBody `catch` h)+testFormInputsPolicyViolation =+    testCase "fileUploads/formInputsPolicy" $+    assertThrows (harness tmpdir hndl mixedTestBody) h   where     h !(e :: FileUploadException) = do         let r = fileUploadExceptionReason e@@ -390,7 +393,7 @@ ------------------------------------------------------------------------------ testTooManyHeaders :: Test testTooManyHeaders = testCase "fileUploads/tooManyHeaders" $-                     (harness tmpdir hndl bigHeadersBody `catch` h)+                     assertThrows (harness tmpdir hndl bigHeadersBody) h   where     h (e :: BadPartException) = show e `deepseq` return () @@ -421,10 +424,9 @@  ------------------------------------------------------------------------------ testSlowEnumerator :: Test-testSlowEnumerator = testCase "fileUploads/tooSlow" $-                     ((harness' goSlowEnumerator tmpdir hndl mixedTestBody-                        >> error "shouldn't get here")-                               `catches` [Handler h0])+testSlowEnumerator =+    testCase "fileUploads/tooSlow" $+    assertThrows (harness' goSlowEnumerator tmpdir hndl mixedTestBody) h0   where     h0 (e :: EscapeSnap) = do         let (TerminateConnection se) = e@@ -448,9 +450,9 @@  ------------------------------------------------------------------------------ testSlowEnumerator2 :: Test-testSlowEnumerator2 = testCase "fileUploads/tooSlow2" $-                      (harness' goSlowEnumerator tmpdir hndl mixedTestBody-                                    `catches` [Handler h0])+testSlowEnumerator2 =+    testCase "fileUploads/tooSlow2" $+    assertThrows (harness' goSlowEnumerator tmpdir hndl mixedTestBody) h0   where     h0 (e :: EscapeSnap) = do         let (TerminateConnection se) = e@@ -551,6 +553,13 @@     createDirectoryIfMissing True tmpdir     !_ <- g hndl body     return ()) `finally` removeDirectoryRecursive tmpdir+++------------------------------------------------------------------------------+assertThrows :: Exception e => IO a -> (e -> IO ()) -> IO ()+assertThrows act handle = catch action handle+  where+    action = act >> assertFailure "Expected exception to be thrown"   ------------------------------------------------------------------------------

@@ -0,0 +1,1 @@+FOO