Changed to fix yesodweb#1846

Oleksandr-Zhabenko · Oct 8, 2024 · a94c215 · a94c215
1 parent 49e7dbe
commit a94c215
Show file tree

Hide file tree

Showing 5 changed files with 53 additions and 7 deletions.
diff --git a/cabal.project.local b/cabal.project.local
@@ -0,0 +1 @@
+ignore-project: False
diff --git a/stack.yaml b/stack.yaml
@@ -1,4 +1,4 @@
-resolver: lts-18.3
+resolver: lts-22.27
 packages:
 - ./yesod-core
 - ./yesod-static

diff --git a/stack.yaml.lock b/stack.yaml.lock
@@ -11,9 +11,23 @@ packages:
       size: 114
   original:
     hackage: attoparsec-aeson-2.1.0.0
+- completed:
+    hackage: crypton-1.0.0@sha256:637e58581978c84ef1288d14fa9cac1d2905ef60e319924293bc11250aca882d,14527
+    pantry-tree:
+      sha256: 4b5e5511567c0fe735a224cb8b2b278e1caa79344f2940d030d169e69b1b81e1
+      size: 23275
+  original:
+    hackage: crypton-1.0.0
+- completed:
+    hackage: crypton-conduit-0.2.3@sha256:31f44243b42f344c65be6cd2c39c07994d9186d19d15988656620d1de85aca37,1946
+    pantry-tree:
+      sha256: 06781001956f2ccfae0e6b4f33c213bd3121c6462f8534e9dca87bf51e4663e0
+      size: 592
+  original:
+    hackage: crypton-conduit-0.2.3
 snapshots:
 - completed:
-    sha256: 694573e96dca34db5636edb1fe6c96bb233ca0f9fb96c1ead1671cdfa9bd73e9
-    size: 585603
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/3.yaml
-  original: lts-18.3
+    sha256: bc144ddf301a5c99f2cf51c7de50279ba144fd4486cb3c66f87ed761d6bbf6e9
+    size: 719131
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/27.yaml
+  original: lts-22.27
diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs
@@ -841,7 +841,7 @@ addPostParam name value =
   modifySIO $ \rbd -> rbd { rbdPostData = (addPostData (rbdPostData rbd)) }
   where addPostData (BinaryPostData _) = error "Trying to add post param to binary content."
         addPostData (MultipleItemsPostData posts) =
-          MultipleItemsPostData $ ReqKvPart name value : posts
+          MultipleItemsPostData $ posts <> [ReqKvPart name value] -- See: https://github.com/yesodweb/yesod/issues/1846
 
 -- | Add a parameter with the given name and value to the query string.
 --

diff --git a/yesod-test/test/main.hs b/yesod-test/test/main.hs
@@ -21,6 +21,7 @@ module Main
 import Test.HUnit hiding (Test)
 import Test.Hspec
 import qualified Test.Hspec as Hspec
+--import qualified Test.Syd.Yesod as Syd
 
 import Yesod.Core
 import Yesod.Form
@@ -329,7 +330,7 @@ main = hspec $ do
                     checkByLabel "Red"
                     checkByLabel "Gray"
                     addToken
-                bodyContains "colorCheckBoxes = [Gray,Red]"
+                bodyContains "colorCheckBoxes = [Red,Gray]" -- Since https://github.com/yesodweb/yesod/issues/1846 the order is following the browser order
             yit "can select from select list" $ do
                 get ("/labels-select" :: Text)
                 request $ do
@@ -575,6 +576,36 @@ main = hspec $ do
             statusIs 200
             (requireJSONResponse :: YesodExample site [Text]) `liftedShouldThrow` (\(e :: SomeException) -> True)
 
+    describe "Supports USD" $ yesodSpec defaultRoutedApp $ do
+        yit "Fails with bad input" $ do
+            get HomeR
+            statusIs 200
+
+            request $ do
+              addToken
+              setUrl HomeR
+              setMethod "POST"
+              addPostParam "money" "XXX"
+              addPostParam "money" "XXX"
+            statusIs 400
+        yit "Supports the used in browser order of addPostParam additions" $ do  -- See: https://github.com/yesodweb/yesod/issues/1846
+            get HomeR
+            statusIs 200
+
+            request $ do
+              addToken
+              setUrl HomeR
+              setMethod "POST"
+              -- These two lines are in the wrong order, but that's because yesod-test
+              -- adds POST parameters in the wrong order — instead of appending each
+              -- parameter to the list of parameters, it conses them, which is not what
+              -- web browers do.
+              addPostParam "money" "100"
+              addPostParam "money" "USD"
+            location <- followRedirect
+            liftIO $ location `shouldBe` Right "/"
+            bodyContains "Amount is USD 100"
+
 instance RenderMessage LiteApp FormMessage where
     renderMessage _ _ = defaultFormMessage