From 0adfbc9ecab136bf3c2a590a3e347f75dcebca4b Mon Sep 17 00:00:00 2001 From: Zachary Juang Date: Sat, 16 Dec 2023 22:39:41 -0500 Subject: [PATCH 1/4] read from queryString instead of rawQueryString --- Web/Scotty/Route.hs | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/Web/Scotty/Route.hs b/Web/Scotty/Route.hs index 8a9cb04..6e9305c 100644 --- a/Web/Scotty/Route.hs +++ b/Web/Scotty/Route.hs @@ -11,11 +11,9 @@ import Control.Monad.IO.Class (MonadIO(..)) import UnliftIO (MonadUnliftIO(..)) import qualified Control.Monad.State as MS -import qualified Data.ByteString.Char8 as B - -import Data.Maybe (fromMaybe) import Data.String (fromString) import qualified Data.Text as T +import Data.Text.Encoding (decodeUtf8) import Network.HTTP.Types import Network.Wai (Request(..)) @@ -160,14 +158,14 @@ mkEnv :: MonadIO m => BodyInfo -> Request -> [Param] -> RouteOptions -> m Action mkEnv bodyInfo req captureps opts = do (formps, bodyFiles) <- liftIO $ getFormParamsAndFilesAction req bodyInfo opts let - queryps = parseEncodedParams $ rawQueryString req + queryps = parseEncodedParams $ queryString req bodyFiles' = [ (decodeUtf8Lenient k, fi) | (k,fi) <- bodyFiles ] responseInit <- liftIO $ newTVarIO defaultScottyResponse return $ Env req captureps formps queryps (getBodyAction bodyInfo opts) (getBodyChunkAction bodyInfo) bodyFiles' responseInit -parseEncodedParams :: B.ByteString -> [Param] -parseEncodedParams bs = [ (k, fromMaybe "" v) | (k,v) <- parseQueryText bs ] +parseEncodedParams :: Query -> [Param] +parseEncodedParams qs = [ ( decodeUtf8 k, maybe "" decodeUtf8 v) | (k,v) <- qs ] {- | Match requests using a regular expression. Named captures are not yet supported. From 757e26eb8fc2d33f849f94dca8eb4399be0f3554 Mon Sep 17 00:00:00 2001 From: Zachary Juang Date: Sat, 16 Dec 2023 23:16:38 -0500 Subject: [PATCH 2/4] use decodeUtf8Lenient --- Web/Scotty/Route.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/Web/Scotty/Route.hs b/Web/Scotty/Route.hs index 6e9305c..474a876 100644 --- a/Web/Scotty/Route.hs +++ b/Web/Scotty/Route.hs @@ -13,7 +13,6 @@ import qualified Control.Monad.State as MS import Data.String (fromString) import qualified Data.Text as T -import Data.Text.Encoding (decodeUtf8) import Network.HTTP.Types import Network.Wai (Request(..)) @@ -165,7 +164,7 @@ mkEnv bodyInfo req captureps opts = do parseEncodedParams :: Query -> [Param] -parseEncodedParams qs = [ ( decodeUtf8 k, maybe "" decodeUtf8 v) | (k,v) <- qs ] +parseEncodedParams qs = [ ( decodeUtf8Lenient k, maybe "" decodeUtf8Lenient v) | (k,v) <- qs ] {- | Match requests using a regular expression. Named captures are not yet supported. From 705fc5292c893461297f382849ab4d892c3f9464 Mon Sep 17 00:00:00 2001 From: Zachary Juang Date: Sun, 17 Dec 2023 04:42:02 -0500 Subject: [PATCH 3/4] add test --- test/Web/ScottySpec.hs | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/test/Web/ScottySpec.hs b/test/Web/ScottySpec.hs index af577d3..7c64196 100644 --- a/test/Web/ScottySpec.hs +++ b/test/Web/ScottySpec.hs @@ -11,7 +11,7 @@ import Data.String import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TLE import Network.HTTP.Types -import Network.Wai (Application, responseLBS) +import Network.Wai (Application, Request(queryString), responseLBS) import qualified Control.Exception.Lifted as EL import qualified Control.Exception as E @@ -227,6 +227,15 @@ spec = do ) $ do it "catches a ScottyException" $ do get "/search?query=potato" `shouldRespondWith` 200 { matchBody = "z"} + context "returns query parameter with given name after middleware rewrite" $ do + withApp (do + Scotty.middleware $ \app req sendResponse -> + app req{queryString = [("query", Just "haskell")]} sendResponse + Scotty.matchAny "/search" $ queryParam "query" >>= text + ) $ do + it "returns query parameter with given name" $ do + get "/search" `shouldRespondWith` "haskell" + describe "formParam" $ do let From 8b8270b6abfec4ce1a5d575cc0c9b686e29b9662 Mon Sep 17 00:00:00 2001 From: Zachary Juang Date: Sun, 17 Dec 2023 06:02:55 -0500 Subject: [PATCH 4/4] move test --- test/Web/ScottySpec.hs | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/test/Web/ScottySpec.hs b/test/Web/ScottySpec.hs index 7c64196..a55eb6b 100644 --- a/test/Web/ScottySpec.hs +++ b/test/Web/ScottySpec.hs @@ -174,6 +174,16 @@ spec = do it "Responds with a 302 Redirect" $ do get "/a" `shouldRespondWith` 302 { matchHeaders = ["Location" <:> "/b"] } + describe "middleware" $ do + context "rewrites the query string" $ do + withApp (do + Scotty.middleware $ \app req sendResponse -> + app req{queryString = [("query", Just "haskell")]} sendResponse + Scotty.matchAny "/search" $ queryParam "query" >>= text + ) $ do + it "returns query parameter with given name" $ do + get "/search" `shouldRespondWith` "haskell" + describe "captureParam" $ do withApp ( do @@ -227,15 +237,6 @@ spec = do ) $ do it "catches a ScottyException" $ do get "/search?query=potato" `shouldRespondWith` 200 { matchBody = "z"} - context "returns query parameter with given name after middleware rewrite" $ do - withApp (do - Scotty.middleware $ \app req sendResponse -> - app req{queryString = [("query", Just "haskell")]} sendResponse - Scotty.matchAny "/search" $ queryParam "query" >>= text - ) $ do - it "returns query parameter with given name" $ do - get "/search" `shouldRespondWith` "haskell" - describe "formParam" $ do let