From 8534caa05a02208a5dff11c443bccd7ef44d3c0c Mon Sep 17 00:00:00 2001
From: Yitz Gale <yitz.gale@zoominsoftware.com>
Date: Tue, 19 Sep 2023 13:06:52 +0000
Subject: [PATCH] Add addBareGetParam to yesod-test

---
 yesod-test/ChangeLog.md     |  4 ++++
 yesod-test/Yesod/Test.hs    | 18 ++++++++++++++++++
 yesod-test/test/main.hs     | 28 +++++++++++++++++++++++++++-
 yesod-test/yesod-test.cabal |  2 +-
 4 files changed, 50 insertions(+), 2 deletions(-)

diff --git a/yesod-test/ChangeLog.md b/yesod-test/ChangeLog.md
index 8fa21c843..f650c2320 100644
--- a/yesod-test/ChangeLog.md
+++ b/yesod-test/ChangeLog.md
@@ -1,6 +1,10 @@
 # ChangeLog for yesod-test
 
 
+## 1.6.16
+
+* Add `addBareGetParam` to yesod-test.
+
 ## 1.6.15
 
 * Add `bySelectorLabelContain`. [#1781](https://github.com/yesodweb/yesod/pull/1781)
diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs
index 91884608c..cd18c509e 100644
--- a/yesod-test/Yesod/Test.hs
+++ b/yesod-test/Yesod/Test.hs
@@ -152,6 +152,7 @@ module Yesod.Test
     , setMethod
     , addPostParam
     , addGetParam
+    , addBareGetParam
     , addFile
     , setRequestBody
     , RequestBuilder
@@ -849,6 +850,23 @@ addGetParam name value = modifySIO $ \rbd -> rbd
               : rbdGets rbd
     }
 
+-- | Add a bare parameter with the given name and no value to the query
+-- string. The parameter is added without an @=@ sign.
+--
+-- You can specify the entire query string literally by adding a single bare
+-- parameter and no other parameters.
+--
+-- Since 1.6.16
+-- 
+-- ==== __Examples__
+--
+-- > {-# LANGUAGE OverloadedStrings #-}
+-- > request $ do
+-- >   addBareGetParam "key" -- Adds ?key to the URL
+addBareGetParam :: T.Text -> RequestBuilder site ()
+addBareGetParam name = modifySIO $ \rbd ->
+    rbd {rbdGets = (TE.encodeUtf8 name, Nothing) : rbdGets rbd}
+
 -- | Add a file to be posted with the current request.
 --
 -- Adding a file will automatically change your request content-type to be multipart/form-data.
diff --git a/yesod-test/test/main.hs b/yesod-test/test/main.hs
index 4276c8500..4a0e6a3fb 100644
--- a/yesod-test/test/main.hs
+++ b/yesod-test/test/main.hs
@@ -29,10 +29,12 @@ import Yesod.Test.CssQuery
 import Yesod.Test.TransversingCSS
 import Text.XML
 import Data.Text (Text, pack)
+import Data.Char (toUpper)
 import Data.Monoid ((<>))
 import Control.Applicative
-import Network.Wai (pathInfo, requestHeaders)
+import Network.Wai (pathInfo, rawQueryString, requestHeaders)
 import Network.Wai.Test (SResponse(simpleBody))
+import Numeric (showHex)
 import Data.Maybe (fromMaybe)
 import Data.Either (isLeft, isRight)
 
@@ -46,6 +48,7 @@ import Control.Monad.IO.Unlift (toIO)
 import qualified Web.Cookie as Cookie
 import Data.Maybe (isNothing)
 import qualified Data.Text as T
+import qualified Data.ByteString.Char8 as B8
 import Yesod.Test.Internal (contentTypeHeaderIsUtf8)
 
 parseQuery_ :: Text -> [[SelectorGroup]]
@@ -172,6 +175,27 @@ main = hspec $ do
                 statusIs 200
                 -- They pass through the server correctly.
                 bodyEquals "foo+bar%41<&baz"
+            yit "get params" $ do
+                get ("/query" :: Text)
+                statusIs 200
+                bodyEquals ""
+
+                request $ do
+                    setMethod "GET"
+                    setUrl $ LiteAppRoute ["query"]
+                    -- If value uses special characters,
+                    addGetParam "foo" "foo+bar%41<&baz"
+                    addBareGetParam "goo+car%41<&caz"
+                statusIs 200
+                -- They pass through the server correctly.
+                let pctEnc c = "%" <> (map toUpper $ showHex (fromEnum c) "")
+                    plus = pctEnc '+'
+                    pct  = pctEnc '%'
+                    lt   = pctEnc '<'
+                    amp  = pctEnc '&'
+                bodyEquals $ mconcat
+                  [ "goo", plus, "car", pct, "41", lt, amp, "caz",
+                    "&foo=foo", plus, "bar", pct, "41", lt, amp, "baz"]
             yit "labels" $ do
                 get ("/form" :: Text)
                 statusIs 200
@@ -545,6 +569,8 @@ app = liteApp $ do
         case mfoo of
             Nothing -> error "No foo"
             Just foo -> return foo
+    onStatic "query" . dispatchTo $
+        T.pack . B8.unpack . rawQueryString <$> waiRequest
     onStatic "redirect301" $ dispatchTo $ redirectWith status301 ("/redirectTarget" :: Text) >> return ()
     onStatic "redirect303" $ dispatchTo $ redirectWith status303 ("/redirectTarget" :: Text) >> return ()
     onStatic "redirectTarget" $ dispatchTo $ return ("we have been successfully redirected" :: Text)
diff --git a/yesod-test/yesod-test.cabal b/yesod-test/yesod-test.cabal
index 0e8f9f09e..c659ddef0 100644
--- a/yesod-test/yesod-test.cabal
+++ b/yesod-test/yesod-test.cabal
@@ -1,5 +1,5 @@
 name:               yesod-test
-version:            1.6.15
+version:            1.6.16
 license:            MIT
 license-file:       LICENSE
 author:             Nubis <nubis@woobiz.com.ar>