From 64527fdc53725a4adbd2468bde6eaadc17a40b4c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=A9mie=20Fraudeau?= <22529775+jfraudeau@users.noreply.github.com> Date: Wed, 20 Sep 2023 19:52:46 +0200 Subject: [PATCH 1/5] Fix: avoid matching capture pattern name --- Web/Scotty/Route.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Web/Scotty/Route.hs b/Web/Scotty/Route.hs index f688b908..0fa1cf37 100644 --- a/Web/Scotty/Route.hs +++ b/Web/Scotty/Route.hs @@ -121,10 +121,10 @@ matchRoute (Capture pat) req = go (T.split (=='/') pat) (compress $ T.split (== | otherwise = Nothing -- request string is longer than pattern go p [] prs | T.null (mconcat p) = Just prs -- in case pattern has trailing slashes | otherwise = Nothing -- request string is not long enough - go (p:ps) (r:rs) prs | p == r = go ps rs prs -- equal literals, keeping checking - | T.null p = Nothing -- p is null, but r is not, fail - | T.head p == ':' = go ps rs $ (T.tail p, r) : prs -- p is a capture, add to params - | otherwise = Nothing -- both literals, but unequal, fail + go (p:ps) (r:rs) prs = case T.uncons p of + Just (':', name) -> go ps rs $ (name, r) : prs -- p is a capture, add to params + _ | p == r -> go ps rs prs -- equal literals, keeping checking + | otherwise -> Nothing -- both literals, but unequal, fail compress ("":rest@("":_)) = compress rest compress (x:xs) = x : compress xs compress [] = [] From d236c57a7deb3d08ce167d42f0c8ee25f58d62b9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=A9mie=20Fraudeau?= <22529775+jfraudeau@users.noreply.github.com> Date: Sat, 23 Sep 2023 02:57:04 +0200 Subject: [PATCH 2/5] Add test --- test/Web/ScottySpec.hs | 109 +++++++++++++++++++++++------------------ 1 file changed, 62 insertions(+), 47 deletions(-) diff --git a/test/Web/ScottySpec.hs b/test/Web/ScottySpec.hs index 2b47d242..0e21f683 100644 --- a/test/Web/ScottySpec.hs +++ b/test/Web/ScottySpec.hs @@ -1,22 +1,22 @@ -{-# LANGUAGE OverloadedStrings, CPP #-} -module Web.ScottySpec (main, spec) where +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} -import Test.Hspec -import Test.Hspec.Wai +module Web.ScottySpec (main, spec) where -import Control.Applicative -import Control.Monad -import Data.Char -import Data.String +import Control.Applicative +import qualified Control.Exception as E +import qualified Control.Exception.Lifted as EL +import Control.Monad +import Data.Char +import Data.String import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TLE -import Network.HTTP.Types -import qualified Control.Exception.Lifted as EL -import qualified Control.Exception as E - -import Web.Scotty as Scotty hiding (get, post, put, patch, delete, request, options) +import Network.HTTP.Types +import Test.Hspec +import Test.Hspec.Wai +import Web.Scotty as Scotty hiding (delete, get, options, patch, post, put, request) import qualified Web.Scotty as Scotty -import qualified Web.Scotty.Cookie as SC (getCookie, setSimpleCookie, deleteCookie) +import qualified Web.Scotty.Cookie as SC (deleteCookie, getCookie, setSimpleCookie) #if !defined(mingw32_HOST_OS) import Control.Concurrent.Async (withAsync) @@ -39,22 +39,27 @@ spec :: Spec spec = do let withApp = with . scottyApp describe "ScottyM" $ do - forM_ [ - ("GET", Scotty.get, get) - , ("POST", Scotty.post, (`post` "")) - , ("PUT", Scotty.put, (`put` "")) - , ("PATCH", Scotty.patch, (`patch` "")) - , ("DELETE", Scotty.delete, delete) - , ("OPTIONS", Scotty.options, options) - ] $ \(method, route, makeRequest) -> do - describe (map toLower method) $ do - withApp (route "/scotty" $ html "") $ do - it ("adds route for " ++ method ++ " requests") $ do - makeRequest "/scotty" `shouldRespondWith` 200 - - withApp (route "/scotty" $ html "") $ do - it ("properly handles extra slash routes for " ++ method ++ " requests") $ do - makeRequest "//scotty" `shouldRespondWith` 200 + forM_ + [ ("GET", Scotty.get, get), + ("POST", Scotty.post, (`post` "")), + ("PUT", Scotty.put, (`put` "")), + ("PATCH", Scotty.patch, (`patch` "")), + ("DELETE", Scotty.delete, delete), + ("OPTIONS", Scotty.options, options) + ] + $ \(method, route, makeRequest) -> do + describe (map toLower method) $ do + withApp (route "/scotty" $ html "") $ do + it ("adds route for " ++ method ++ " requests") $ do + makeRequest "/scotty" `shouldRespondWith` 200 + + withApp (route "/scotty" $ html "") $ do + it ("properly handles extra slash routes for " ++ method ++ " requests") $ do + makeRequest "//scotty" `shouldRespondWith` 200 + + withApp (route "/:paramName" $ param "paramName" >>= text) $ do + it ("captures route parameters for " ++ method ++ " requests when parameter matches its name") $ do + makeRequest "/:paramName" `shouldRespondWith` ":paramName" describe "addroute" $ do forM_ availableMethods $ \method -> do @@ -103,8 +108,8 @@ spec = do withApp (Scotty.get "/dictionary" $ empty <|> param "word1" <|> empty <|> param "word2" >>= text) $ it "has an Alternative instance" $ do - get "/dictionary?word1=haskell" `shouldRespondWith` "haskell" - get "/dictionary?word2=scotty" `shouldRespondWith` "scotty" + get "/dictionary?word1=haskell" `shouldRespondWith` "haskell" + get "/dictionary?word2=scotty" `shouldRespondWith` "scotty" get "/dictionary?word1=a&word2=b" `shouldRespondWith` "a" describe "param" $ do @@ -114,19 +119,26 @@ spec = do context "when used with application/x-www-form-urlencoded data" $ do it "returns POST parameter with given name" $ do - request "POST" "/search" [("Content-Type","application/x-www-form-urlencoded")] "query=haskell" `shouldRespondWith` "haskell" + request "POST" "/search" [("Content-Type", "application/x-www-form-urlencoded")] "query=haskell" `shouldRespondWith` "haskell" it "replaces non UTF-8 bytes with Unicode replacement character" $ do - request "POST" "/search" [("Content-Type","application/x-www-form-urlencoded")] "query=\xe9" `shouldRespondWith` "\xfffd" - + request "POST" "/search" [("Content-Type", "application/x-www-form-urlencoded")] "query=\xe9" `shouldRespondWith` "\xfffd" describe "requestLimit" $ do 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 - request "POST" "/upload" [("Content-Type","multipart/form-data; boundary=--33")] - (TLE.encodeUtf8 . TL.pack . concat $ [show c | c <- ([1..4500]::[Integer])]) `shouldRespondWith` 413 - request "POST" "/upload" [("Content-Type","multipart/form-data; boundary=--33")] - (TLE.encodeUtf8 . TL.pack . concat $ [show c | c <- ([1..50]::[Integer])]) `shouldRespondWith` 200 + request + "POST" + "/upload" + [("Content-Type", "multipart/form-data; boundary=--33")] + (TLE.encodeUtf8 . TL.pack . concat $ [show c | c <- ([1 .. 4500] :: [Integer])]) + `shouldRespondWith` 413 + request + "POST" + "/upload" + [("Content-Type", "multipart/form-data; boundary=--33")] + (TLE.encodeUtf8 . TL.pack . concat $ [show c | c <- ([1 .. 50] :: [Integer])]) + `shouldRespondWith` 200 describe "text" $ do let modernGreekText :: IsString a => a @@ -159,7 +171,7 @@ spec = do get "/scotty" `shouldRespondWith` 200 {matchHeaders = ["Content-Type" <:> "text/somethingweird"]} describe "json" $ do - withApp (Scotty.get "/scotty" $ setHeader "Content-Type" "text/somethingweird" >> json (Just (5::Int))) $ do + withApp (Scotty.get "/scotty" $ setHeader "Content-Type" "text/somethingweird" >> json (Just (5 :: Int))) $ do it "doesn't override a previously set Content-Type header" $ do get "/scotty" `shouldRespondWith` 200 {matchHeaders = ["Content-Type" <:> "text/somethingweird"]} @@ -178,13 +190,16 @@ spec = do get "/scotty" `shouldRespondWith` 200 {matchHeaders = ["Set-Cookie" <:> "foo=bar"]} describe "getCookie" $ do - withApp (Scotty.get "/scotty" $ do - mt <- SC.getCookie "foo" - case mt of - Just "bar" -> Scotty.status status200 - _ -> Scotty.status status400 ) $ do - it "finds the right cookie in the request headers" $ do - request "GET" "/scotty" [("Cookie", "foo=bar")] "" `shouldRespondWith` 200 + withApp + ( Scotty.get "/scotty" $ do + mt <- SC.getCookie "foo" + case mt of + Just "bar" -> Scotty.status status200 + _ -> Scotty.status status400 + ) + $ do + it "finds the right cookie in the request headers" $ do + request "GET" "/scotty" [("Cookie", "foo=bar")] "" `shouldRespondWith` 200 describe "deleteCookie" $ do withApp (Scotty.get "/scotty" $ SC.deleteCookie "foo") $ do From ffd4983fa366e21d9ef97055ea0f14f63679dd27 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=A9mie=20Fraudeau?= <22529775+jfraudeau@users.noreply.github.com> Date: Sat, 23 Sep 2023 18:18:35 +0200 Subject: [PATCH 3/5] Undo reformating --- test/Web/ScottySpec.hs | 114 ++++++++++++++++++----------------------- 1 file changed, 51 insertions(+), 63 deletions(-) diff --git a/test/Web/ScottySpec.hs b/test/Web/ScottySpec.hs index 0e21f683..f0a6126f 100644 --- a/test/Web/ScottySpec.hs +++ b/test/Web/ScottySpec.hs @@ -1,22 +1,22 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} - +{-# LANGUAGE OverloadedStrings, CPP #-} module Web.ScottySpec (main, spec) where -import Control.Applicative -import qualified Control.Exception as E -import qualified Control.Exception.Lifted as EL -import Control.Monad -import Data.Char -import Data.String +import Test.Hspec +import Test.Hspec.Wai + +import Control.Applicative +import Control.Monad +import Data.Char +import Data.String import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TLE -import Network.HTTP.Types -import Test.Hspec -import Test.Hspec.Wai -import Web.Scotty as Scotty hiding (delete, get, options, patch, post, put, request) +import Network.HTTP.Types +import qualified Control.Exception.Lifted as EL +import qualified Control.Exception as E + +import Web.Scotty as Scotty hiding (get, post, put, patch, delete, request, options) import qualified Web.Scotty as Scotty -import qualified Web.Scotty.Cookie as SC (deleteCookie, getCookie, setSimpleCookie) +import qualified Web.Scotty.Cookie as SC (getCookie, setSimpleCookie, deleteCookie) #if !defined(mingw32_HOST_OS) import Control.Concurrent.Async (withAsync) @@ -39,28 +39,26 @@ spec :: Spec spec = do let withApp = with . scottyApp describe "ScottyM" $ do - forM_ - [ ("GET", Scotty.get, get), - ("POST", Scotty.post, (`post` "")), - ("PUT", Scotty.put, (`put` "")), - ("PATCH", Scotty.patch, (`patch` "")), - ("DELETE", Scotty.delete, delete), - ("OPTIONS", Scotty.options, options) - ] - $ \(method, route, makeRequest) -> do - describe (map toLower method) $ do - withApp (route "/scotty" $ html "") $ do - it ("adds route for " ++ method ++ " requests") $ do - makeRequest "/scotty" `shouldRespondWith` 200 - - withApp (route "/scotty" $ html "") $ do - it ("properly handles extra slash routes for " ++ method ++ " requests") $ do - makeRequest "//scotty" `shouldRespondWith` 200 - - withApp (route "/:paramName" $ param "paramName" >>= text) $ do - it ("captures route parameters for " ++ method ++ " requests when parameter matches its name") $ do - makeRequest "/:paramName" `shouldRespondWith` ":paramName" - + forM_ [ + ("GET", Scotty.get, get) + , ("POST", Scotty.post, (`post` "")) + , ("PUT", Scotty.put, (`put` "")) + , ("PATCH", Scotty.patch, (`patch` "")) + , ("DELETE", Scotty.delete, delete) + , ("OPTIONS", Scotty.options, options) + ] $ \(method, route, makeRequest) -> do + describe (map toLower method) $ do + withApp (route "/scotty" $ html "") $ do + it ("adds route for " ++ method ++ " requests") $ do + makeRequest "/scotty" `shouldRespondWith` 200 + + withApp (route "/scotty" $ html "") $ do + it ("properly handles extra slash routes for " ++ method ++ " requests") $ do + makeRequest "//scotty" `shouldRespondWith` 200 + + withApp (route "/:paramName" $ param "paramName" >>= text) $ do + it ("captures route parameters for " ++ method ++ " requests when parameter matches its name") $ do + makeRequest "/:paramName" `shouldRespondWith` ":paramName" describe "addroute" $ do forM_ availableMethods $ \method -> do withApp (addroute method "/scotty" $ html "") $ do @@ -108,8 +106,8 @@ spec = do withApp (Scotty.get "/dictionary" $ empty <|> param "word1" <|> empty <|> param "word2" >>= text) $ it "has an Alternative instance" $ do - get "/dictionary?word1=haskell" `shouldRespondWith` "haskell" - get "/dictionary?word2=scotty" `shouldRespondWith` "scotty" + get "/dictionary?word1=haskell" `shouldRespondWith` "haskell" + get "/dictionary?word2=scotty" `shouldRespondWith` "scotty" get "/dictionary?word1=a&word2=b" `shouldRespondWith` "a" describe "param" $ do @@ -119,26 +117,19 @@ spec = do context "when used with application/x-www-form-urlencoded data" $ do it "returns POST parameter with given name" $ do - request "POST" "/search" [("Content-Type", "application/x-www-form-urlencoded")] "query=haskell" `shouldRespondWith` "haskell" + request "POST" "/search" [("Content-Type","application/x-www-form-urlencoded")] "query=haskell" `shouldRespondWith` "haskell" it "replaces non UTF-8 bytes with Unicode replacement character" $ do - request "POST" "/search" [("Content-Type", "application/x-www-form-urlencoded")] "query=\xe9" `shouldRespondWith` "\xfffd" + request "POST" "/search" [("Content-Type","application/x-www-form-urlencoded")] "query=\xe9" `shouldRespondWith` "\xfffd" + describe "requestLimit" $ do 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 - request - "POST" - "/upload" - [("Content-Type", "multipart/form-data; boundary=--33")] - (TLE.encodeUtf8 . TL.pack . concat $ [show c | c <- ([1 .. 4500] :: [Integer])]) - `shouldRespondWith` 413 - request - "POST" - "/upload" - [("Content-Type", "multipart/form-data; boundary=--33")] - (TLE.encodeUtf8 . TL.pack . concat $ [show c | c <- ([1 .. 50] :: [Integer])]) - `shouldRespondWith` 200 + request "POST" "/upload" [("Content-Type","multipart/form-data; boundary=--33")] + (TLE.encodeUtf8 . TL.pack . concat $ [show c | c <- ([1..4500]::[Integer])]) `shouldRespondWith` 413 + request "POST" "/upload" [("Content-Type","multipart/form-data; boundary=--33")] + (TLE.encodeUtf8 . TL.pack . concat $ [show c | c <- ([1..50]::[Integer])]) `shouldRespondWith` 200 describe "text" $ do let modernGreekText :: IsString a => a @@ -171,7 +162,7 @@ spec = do get "/scotty" `shouldRespondWith` 200 {matchHeaders = ["Content-Type" <:> "text/somethingweird"]} describe "json" $ do - withApp (Scotty.get "/scotty" $ setHeader "Content-Type" "text/somethingweird" >> json (Just (5 :: Int))) $ do + withApp (Scotty.get "/scotty" $ setHeader "Content-Type" "text/somethingweird" >> json (Just (5::Int))) $ do it "doesn't override a previously set Content-Type header" $ do get "/scotty" `shouldRespondWith` 200 {matchHeaders = ["Content-Type" <:> "text/somethingweird"]} @@ -190,16 +181,13 @@ spec = do get "/scotty" `shouldRespondWith` 200 {matchHeaders = ["Set-Cookie" <:> "foo=bar"]} describe "getCookie" $ do - withApp - ( Scotty.get "/scotty" $ do - mt <- SC.getCookie "foo" - case mt of - Just "bar" -> Scotty.status status200 - _ -> Scotty.status status400 - ) - $ do - it "finds the right cookie in the request headers" $ do - request "GET" "/scotty" [("Cookie", "foo=bar")] "" `shouldRespondWith` 200 + withApp (Scotty.get "/scotty" $ do + mt <- SC.getCookie "foo" + case mt of + Just "bar" -> Scotty.status status200 + _ -> Scotty.status status400 ) $ do + it "finds the right cookie in the request headers" $ do + request "GET" "/scotty" [("Cookie", "foo=bar")] "" `shouldRespondWith` 200 describe "deleteCookie" $ do withApp (Scotty.get "/scotty" $ SC.deleteCookie "foo") $ do From 37614cf4059ce1a7845728d7350cb7c7321740ff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=A9mie=20Fraudeau?= <22529775+jfraudeau@users.noreply.github.com> Date: Thu, 16 Nov 2023 11:37:15 +0100 Subject: [PATCH 4/5] Fix: replace obsolete use of param --- test/Web/ScottySpec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/Web/ScottySpec.hs b/test/Web/ScottySpec.hs index ec0bdf80..f68267d7 100644 --- a/test/Web/ScottySpec.hs +++ b/test/Web/ScottySpec.hs @@ -56,7 +56,7 @@ spec = do it ("properly handles extra slash routes for " ++ method ++ " requests") $ do makeRequest "//scotty" `shouldRespondWith` 200 - withApp (route "/:paramName" $ param "paramName" >>= text) $ do + withApp (route "/:paramName" $ captureParam "paramName" >>= text) $ do it ("captures route parameters for " ++ method ++ " requests when parameter matches its name") $ do makeRequest "/:paramName" `shouldRespondWith` ":paramName" describe "addroute" $ do From a96a86020e692be26ff44a8cc3332920e6558f13 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?J=C3=A9r=C3=A9mie=20Fraudeau?= <22529775+jfraudeau@users.noreply.github.com> Date: Mon, 18 Dec 2023 14:02:45 +0100 Subject: [PATCH 5/5] Add changelog entry --- changelog.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/changelog.md b/changelog.md index 267a3a1c..c2c52a49 100644 --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,8 @@ ## next [????.??.??] +### Fixes +* Path parameters with value matching the parameter name prefixed by colon will properly populate `pathParams` with their literal value : `/:param` will match `/:param` and add a `Param` with value `("param", ":param")` (#301) + ## 0.21 [2023.12.17] ### New