Add addBareGetParam to yesod-test

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)

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.

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)

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 <[email protected]>