Fix rejectUnknownFields to respect fieldLabelModifier

* Apply `fieldLabelModifier` to known fields reflected from the
  `FieldName` class. While NOT applying the `fieldLabelModofier` to the
  encoding tags.
* Change the intermediary type returned by the `FieldName` class from
  `Text` to `String` to reduce `{un,}pack` calls to a minimum.
* Update tests which specified the problem before to assert the fixed
  semantics.

[fix #773]

Author: mbj

Data/Aeson/TH.hs

@@ -939,7 +939,7 @@ parseRecord jc tvMap argTys opts tName conName fields obj inTaggedObject =
           if inTaggedObject then (tagFieldName (sumEncoding opts) :) else id
       knownFields = appE [|H.fromList|] $ listE $
           map (\knownName -> tupE [appE [|T.pack|] $ litE $ stringL knownName, [|()|]]) $
-              tagFieldNameAppender $ map nameBase fields
+              tagFieldNameAppender $ map (fieldLabel opts) fields
       checkUnknownRecords =
           caseE (appE [|H.keys|] $ infixApp (varE obj) [|H.difference|] knownFields)
               [ match (listP []) (normalB [|return ()|]) []

Data/Aeson/Types/FromJSON.hs

@@ -1260,15 +1260,15 @@ instance (ProductFromJSON arity f, ProductSize f
 --------------------------------------------------------------------------------
 
 class FieldNames f where
-    fieldNames :: f a -> [Text] -> [Text]
+    fieldNames :: f a -> [String] -> [String]
 
 instance (FieldNames a, FieldNames b) => FieldNames (a :*: b) where
     fieldNames _ =
       fieldNames (undefined :: a x) .
       fieldNames (undefined :: b y)
 
 instance (Selector s) => FieldNames (S1 s f) where
-    fieldNames _ = (pack (selName (undefined :: M1 _i s _f _p)) :)
+    fieldNames _ = ((selName (undefined :: M1 _i s _f _p)) :)
 
 class RecordFromJSON arity f where
     recordParseJSON
@@ -1282,9 +1282,10 @@ instance ( FieldNames f
         \obj -> checkUnknown obj >> recordParseJSON' p obj
         where
             knownFields :: H.HashMap Text ()
-            knownFields = H.fromList $ map (,()) $
-                fieldNames (undefined :: f a)
-                [pack (tagFieldName (sumEncoding opts)) | fromTaggedSum]
+            knownFields = H.fromList $ map ((,()) . pack) $
+                [tagFieldName (sumEncoding opts) | fromTaggedSum] <>
+                (fieldLabelModifier opts <$> fieldNames (undefined :: f a) [])
+
             checkUnknown =
                 if not (rejectUnknownFields opts)
                 then \_ -> return ()

changelog.md

@@ -3,6 +3,7 @@ For the latest version of this document, please see [https://github.com/bos/aeso
 #### 1.4.7.1
 
 * GHC 8.10 compatibility, thanks to Ryan Scott.
+* Fix bug in `rejectUnknownFields` not respecting `fieldLabelModifier`.
 
 ### 1.4.7.0
 

tests/ErrorMessages.hs

@@ -141,7 +141,7 @@ outputGeneric choice = concat
       (select
         thSomeTypeParseJSONRejectUnknownFields
         gSomeTypeParseJSONRejectUnknownFields)
-      [ "{\"tag\": \"record\", \"testOne\": 1.0, \"testZero\": 1}"
+      [ "{\"tag\": \"record\", \"testone\": 1.0, \"testZero\": 1}"
       , "{\"testZero\": 1}"
       , "{\"tag\": \"record\", \"testone\": true, \"testtwo\": null, \"testthree\": null}"
       ]

tests/golden/generic.expected

@@ -34,7 +34,7 @@ Error in $: not enough input. Expecting json list value
 SomeType (reject unknown fields)
 Error in $: parsing Types.SomeType(Record) failed, unknown fields: ["testZero"]
 Error in $: parsing Types.SomeType failed, expected Object with key "tag" containing one of ["nullary","unary","product","record","list"], key "tag" not found
-Error in $: parsing Types.SomeType(Record) failed, unknown fields: ["testtwo","testone","testthree"]
+Error in $.testone: parsing Double failed, unexpected Boolean
 Foo (reject unknown fields)
 Error in $: parsing Types.Foo(Foo) failed, unknown fields: ["tag"]
 Foo (reject unknown fields, tagged single)

tests/golden/th.expected

@@ -34,7 +34,7 @@ Error in $: not enough input. Expecting json list value
 SomeType (reject unknown fields)
 Error in $: Unknown fields: ["testZero"]
 Error in $: key "tag" not found
-Error in $: Unknown fields: ["testtwo","testone","testthree"]
+Error in $.testone: parsing Double failed, unexpected Boolean
 Foo (reject unknown fields)
 Error in $: Unknown fields: ["tag"]
 Foo (reject unknown fields, tagged single)