add counterexample test to setMaxRequestBodySize

scotty-web · Sep 27, 2023 · e62fc7c · e62fc7c
1 parent 1ba455c
commit e62fc7c
Show file tree

Hide file tree

Showing 4 changed files with 30 additions and 17 deletions.
diff --git a/Web/Scotty/Action.hs b/Web/Scotty/Action.hs
@@ -47,7 +47,7 @@ import           Blaze.ByteString.Builder   (fromLazyByteString)
 
 import qualified Control.Exception          as E
 import           Control.Monad              (liftM, when)
-import           Control.Monad.Error.Class
+import           Control.Monad.Error.Class (throwError, catchError)
 import           Control.Monad.IO.Class     (MonadIO(..))
 import           Control.Monad.Reader       (MonadReader(..), ReaderT(..))
 import qualified Control.Monad.State.Strict as MS

diff --git a/Web/Scotty/Internal/Types.hs b/Web/Scotty/Internal/Types.hs
@@ -70,6 +70,16 @@ type Kilobytes = Int
 type Middleware m = Application m -> Application m
 type Application m = Request -> m Response
 
+------------------ Scotty Request Body --------------------
+
+data BodyChunkBuffer = BodyChunkBuffer { hasFinishedReadingChunks :: Bool
+                                       , chunksReadSoFar :: [BS.ByteString] }
+
+data BodyInfo = BodyInfo { bodyInfoReadProgress :: MVar Int
+                         , bodyInfoChunkBuffer :: MVar BodyChunkBuffer
+                         , bodyInfoDirectChunkRead :: IO BS.ByteString
+                         }
+
 --------------- Scotty Applications -----------------
 
 data ScottyState e m =
@@ -287,12 +297,4 @@ instance IsString RoutePattern where
     fromString = Capture . pack
 
 
------------------- Scotty Request Body --------------------
-
-data BodyChunkBuffer = BodyChunkBuffer { hasFinishedReadingChunks :: Bool
-                                       , chunksReadSoFar :: [BS.ByteString] }
 
-data BodyInfo = BodyInfo { bodyInfoReadProgress :: MVar Int
-                         , bodyInfoChunkBuffer :: MVar BodyChunkBuffer
-                         , bodyInfoDirectChunkRead :: IO BS.ByteString
-                         }
diff --git a/Web/Scotty/Util.hs b/Web/Scotty/Util.hs
@@ -95,9 +95,9 @@ readRequestBody rbody prefix maxSize = do
           checkBodyLength = \case
             Just maxSize' -> do
               bodySoFar <- prefix []
-              when (isBigger bodySoFar maxSize') readUntilEmpty
+              when (bodySoFar `isBigger` maxSize') readUntilEmpty
             Nothing -> return ()
-          isBigger bodySoFar maxSize' = (B.length . B.concat $ bodySoFar) > maxSize' * 1024
+          isBigger bodySoFar maxSize' = (B.length . B.concat $ bodySoFar) > maxSize' * 1024 -- XXX this looks both inefficient and wrong
           readUntilEmpty = do
             b <- rbody
             if B.null b

diff --git a/test/Web/ScottySpec.hs b/test/Web/ScottySpec.hs
@@ -97,13 +97,23 @@ spec = do
           it "returns 500 on exceptions" $ do
             get "/" `shouldRespondWith` "<h1>500 Internal Server Error</h1>divide by zero" {matchStatus = 500}
 
+
     describe "setMaxRequestBodySize" $ do
+      let
+        large = TLE.encodeUtf8 . TL.pack . concat $ [show c | c <- ([1..4500]::[Integer])]
+        smol = TLE.encodeUtf8 . TL.pack . concat $ [show c | c <- ([1..50]::[Integer])]
+      context "(counterexample)" $
+        withApp (Scotty.post "/" $ status status200) $ do
+          it "doesn't throw an uncaught exception if the body is large" $ do
+            request "POST" "/" [("Content-Type","multipart/form-data; boundary=--33")]
+              large `shouldRespondWith` 200
       withApp (Scotty.setMaxRequestBodySize 1 >> Scotty.matchAny "/upload" (do status status200)) $ do
-        it "upload endpoint for max-size requests, status 413 if request is too big, 200 otherwise" $ do
+        it "should return 200 OK if the request body size is below 1 KB" $ do
           request "POST" "/upload" [("Content-Type","multipart/form-data; boundary=--33")]
-            (TLE.encodeUtf8 . TL.pack . concat $ [show c | c <- ([1..50]::[Integer])]) `shouldRespondWith` 200
+            smol `shouldRespondWith` 200
+        it "should return 413 (Content Too Large) if the request body size is above 1 KB" $ do
           request "POST" "/upload" [("Content-Type","multipart/form-data; boundary=--33")]
-            (TLE.encodeUtf8 . TL.pack . concat $ [show c | c <- ([1..4500]::[Integer])]) `shouldRespondWith` 413
+            large `shouldRespondWith` 413
 
   describe "ActionM" $ do
     withApp (Scotty.get "/" $ (undefined `EL.catch` ((\_ -> html "") :: E.SomeException -> ActionM ()))) $ do
@@ -173,13 +183,13 @@ spec = do
           request "POST" "/search" [("Content-Type","application/x-www-form-urlencoded")] "query=potato" `shouldRespondWith` 400
 
       withApp (do
-                  Scotty.post "/first" $ next
-                  Scotty.post "/first" $ do
+                  Scotty.post "/" $ next
+                  Scotty.post "/" $ do
                     p :: Int <- formParam "p"
                     json p
               ) $ do
         it "preserves the body of a POST request even after 'next' (#147)" $ do
-          request "POST" "/first" [("Content-Type","application/x-www-form-urlencoded")] "p=42" `shouldRespondWith` "42"
+          request "POST" "/" [("Content-Type","application/x-www-form-urlencoded")] "p=42" `shouldRespondWith` "42"
 
 
     describe "text" $ do
@@ -297,3 +307,4 @@ listenOn path =
       return sock
     )
 #endif
+