From c186c556e779e6c6a64a06d1f6d32fe12bc717bb Mon Sep 17 00:00:00 2001 From: AugmenTab Date: Tue, 6 Jan 2026 18:42:15 -0600 Subject: [PATCH 1/2] Preserves the order of inserted field values When a form includes multiple fields with the same name (and thus multiple values for that field), we were inserting them with `Map.insertWith (<>)`. The order of arguments to `Map.insertWith` is the new value first, followed by the old value, so we were building the list in reverse order while merging. This corrects to building the list using the same order as in the request, and includes a simple test to verify. --- orb.cabal | 1 + package.yaml | 1 - src/Orb/Handler/Form.hs | 8 +++++-- stack.yaml.lock | 24 +++++++++---------- test/Form.hs | 51 +++++++++++++++++++++++++++++++++++++++++ test/Main.hs | 4 +++- 6 files changed, 73 insertions(+), 16 deletions(-) create mode 100644 test/Form.hs diff --git a/orb.cabal b/orb.cabal index e789d23..e4adc5b 100644 --- a/orb.cabal +++ b/orb.cabal @@ -129,6 +129,7 @@ test-suite orb-test Fixtures.SimplePost Fixtures.TaggedUnion Fixtures.Union + Form Handler OpenApi SwaggerUI diff --git a/package.yaml b/package.yaml index 62a1ddc..6710a59 100644 --- a/package.yaml +++ b/package.yaml @@ -31,7 +31,6 @@ extra-source-files: - src/Orb/SwaggerUI/swagger-ui-dist-5.25.2/swagger-ui-standalone-preset.js - src/Orb/SwaggerUI/swagger-ui-dist-5.25.2/swagger-ui.css - src/Orb/SwaggerUI/swagger-ui-dist-5.25.2/swagger-ui.js - # Metadata used when publishing your package # synopsis: Short description of your package diff --git a/src/Orb/Handler/Form.hs b/src/Orb/Handler/Form.hs index 8859bdd..2dfe034 100644 --- a/src/Orb/Handler/Form.hs +++ b/src/Orb/Handler/Form.hs @@ -42,7 +42,7 @@ insertParamField :: Map.Map T.Text (NEL.NonEmpty T.Text) insertParamField params (k, v) = Map.insertWith - (<>) + appendField (TE.decodeUtf8 k) (NEL.singleton $ TE.decodeUtf8 v) params @@ -53,11 +53,15 @@ insertFileField :: Map.Map T.Text (NEL.NonEmpty (Wai.FileInfo LBS.ByteString)) insertFileField files (k, v) = Map.insertWith - (<>) + appendField (TE.decodeUtf8 k) (NEL.singleton v) files +appendField :: NEL.NonEmpty a -> NEL.NonEmpty a -> NEL.NonEmpty a +appendField new old = + old <> new + data FormField = ParamField (NEL.NonEmpty T.Text) | FileField (NEL.NonEmpty (Wai.FileInfo LBS.ByteString)) diff --git a/stack.yaml.lock b/stack.yaml.lock index d5c5a56..6a32957 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -57,29 +57,29 @@ packages: - completed: name: json-fleece-aeson pantry-tree: - sha256: 4821f2305b6a4a38fea102375dce74a3f9296cb804aaa009fead93d07b73e51d - size: 581 - sha256: f39c90b9e0dd1efbc362fd4f012ca9d0475bba7982b97964b97b8a598f3165d7 - size: 3068986 + sha256: d687b890f3727930fba309980fdb2b7f099e3c6092006940867c7fed3c19bd64 + size: 628 + sha256: d37000c263116c1f30d69dde80ece99f2a0037a5f07a378537cb282c3ac5debf + size: 3073901 subdir: json-fleece-aeson - url: https://github.com/flipstone/json-fleece/archive/4dcf90fc0c24abe28dfa029db74adc32dbb6b027.tar.gz + url: https://github.com/flipstone/json-fleece/archive/2064e681d594a603fcbaf2e58105c64ee53156a1.tar.gz version: 0.3.8.0 original: subdir: json-fleece-aeson - url: https://github.com/flipstone/json-fleece/archive/4dcf90fc0c24abe28dfa029db74adc32dbb6b027.tar.gz + url: https://github.com/flipstone/json-fleece/archive/2064e681d594a603fcbaf2e58105c64ee53156a1.tar.gz - completed: name: json-fleece-core pantry-tree: - sha256: 4f1b4f4684155abec72fe865975865e0caa94a01440c0281e38f864afb052c02 - size: 444 - sha256: f39c90b9e0dd1efbc362fd4f012ca9d0475bba7982b97964b97b8a598f3165d7 - size: 3068986 + sha256: 5adc2bf8c045e936eeb32d4388ee1dcd44cb4557e078b485c9a7415b98a9387f + size: 491 + sha256: d37000c263116c1f30d69dde80ece99f2a0037a5f07a378537cb282c3ac5debf + size: 3073901 subdir: json-fleece-core - url: https://github.com/flipstone/json-fleece/archive/4dcf90fc0c24abe28dfa029db74adc32dbb6b027.tar.gz + url: https://github.com/flipstone/json-fleece/archive/2064e681d594a603fcbaf2e58105c64ee53156a1.tar.gz version: 0.8.0.0 original: subdir: json-fleece-core - url: https://github.com/flipstone/json-fleece/archive/4dcf90fc0c24abe28dfa029db74adc32dbb6b027.tar.gz + url: https://github.com/flipstone/json-fleece/archive/2064e681d594a603fcbaf2e58105c64ee53156a1.tar.gz snapshots: - completed: sha256: 0d0bb681dd5be9b930c8fc070d717aae757b9aed176ae6047d87624b46406816 diff --git a/test/Form.hs b/test/Form.hs new file mode 100644 index 0000000..7a0e2a3 --- /dev/null +++ b/test/Form.hs @@ -0,0 +1,51 @@ +module Form + ( testGroup + ) where + +import Data.List.NonEmpty qualified as NEL +import Data.Map.Strict qualified as Map +import Data.Text qualified as T +import Data.Text.Encoding qualified as TE +import Hedgehog ((===)) +import Hedgehog qualified as HH +import Hedgehog.Gen qualified as Gen +import Hedgehog.Range qualified as Range +import Test.Tasty qualified as Tasty +import Test.Tasty.Hedgehog qualified as TastyHH + +import Orb qualified + +testGroup :: Tasty.TestTree +testGroup = + Tasty.testGroup + "Form" + [ TastyHH.testProperty "preserves the order of a repeated param" prop_repeatedParamOrderPreserved + ] + +prop_repeatedParamOrderPreserved :: HH.Property +prop_repeatedParamOrderPreserved = HH.property $ do + vals <- + HH.forAll + . Gen.nonEmpty (Range.linear 1 50) + $ Gen.text (Range.linear 1 12) Gen.alphaNum + + let + keyText = T.pack "item" + key = TE.encodeUtf8 keyText + params = + [ (key, TE.encodeUtf8 v) + | v <- NEL.toList vals + ] + + form <- HH.evalEither $ Orb.getForm (params, []) + field <- + maybe + (fail "Expected key 'item' to exist in the form.") + pure + (Map.lookup keyText form) + + case field of + Orb.ParamField ps -> + NEL.toList ps === NEL.toList vals + Orb.FileField _fs -> + fail "Expected ParamField for 'item', but got FileField." diff --git a/test/Main.hs b/test/Main.hs index b7ce422..dff7406 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -4,6 +4,7 @@ module Main import Test.Tasty qualified as Tasty +import Form qualified import Handler qualified import OpenApi qualified import SwaggerUI qualified @@ -13,7 +14,8 @@ main = Tasty.defaultMain $ Tasty.testGroup "Orb" - [ Handler.testGroup + [ Form.testGroup + , Handler.testGroup , OpenApi.testGroup , SwaggerUI.testGroup ] From 1510843861b19ea6da36142213edf0f13ca0cbe2 Mon Sep 17 00:00:00 2001 From: AugmenTab Date: Wed, 7 Jan 2026 20:34:20 -0600 Subject: [PATCH 2/2] Swaps `appendField` for `flip (<>)` --- src/Orb/Handler/Form.hs | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/src/Orb/Handler/Form.hs b/src/Orb/Handler/Form.hs index 2dfe034..ceaf7ef 100644 --- a/src/Orb/Handler/Form.hs +++ b/src/Orb/Handler/Form.hs @@ -42,7 +42,7 @@ insertParamField :: Map.Map T.Text (NEL.NonEmpty T.Text) insertParamField params (k, v) = Map.insertWith - appendField + (flip (<>)) (TE.decodeUtf8 k) (NEL.singleton $ TE.decodeUtf8 v) params @@ -53,15 +53,11 @@ insertFileField :: Map.Map T.Text (NEL.NonEmpty (Wai.FileInfo LBS.ByteString)) insertFileField files (k, v) = Map.insertWith - appendField + (flip (<>)) (TE.decodeUtf8 k) (NEL.singleton v) files -appendField :: NEL.NonEmpty a -> NEL.NonEmpty a -> NEL.NonEmpty a -appendField new old = - old <> new - data FormField = ParamField (NEL.NonEmpty T.Text) | FileField (NEL.NonEmpty (Wai.FileInfo LBS.ByteString))