diff --git a/Data/Aeson/TH.hs b/Data/Aeson/TH.hs index aacf0cfce..3dd63521b 100644 --- a/Data/Aeson/TH.hs +++ b/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 ()|]) [] diff --git a/Data/Aeson/Types/FromJSON.hs b/Data/Aeson/Types/FromJSON.hs index 34aa14b98..bfd33e6ba 100644 --- a/Data/Aeson/Types/FromJSON.hs +++ b/Data/Aeson/Types/FromJSON.hs @@ -1260,7 +1260,7 @@ 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 _ = @@ -1268,7 +1268,7 @@ instance (FieldNames a, FieldNames b) => FieldNames (a :*: b) where 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 () diff --git a/changelog.md b/changelog.md index 660d047df..c31d8a969 100644 --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,8 @@ For the latest version of this document, please see [https://github.com/bos/aeson/blob/master/changelog.md](https://github.com/bos/aeson/blob/master/changelog.md). +## 1.5.0.0 +* Fix bug in `rejectUnknownFields` not respecting `fieldLabelModifier`, thanks to Markus Schirp. + #### 1.4.7.1 * GHC 8.10 compatibility, thanks to Ryan Scott. diff --git a/tests/ErrorMessages.hs b/tests/ErrorMessages.hs index 0b3620e10..eabb5e8a0 100644 --- a/tests/ErrorMessages.hs +++ b/tests/ErrorMessages.hs @@ -31,6 +31,7 @@ tests :: [TestTree] tests = [ aesonGoldenTest "simple" "tests/golden/simple.expected" output , aesonGoldenTest "generic" "tests/golden/generic.expected" (outputGeneric G) + , aesonGoldenTest "generic" "tests/golden/th.expected" (outputGeneric TH) ] output :: Output @@ -140,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}" ] diff --git a/tests/golden/generic.expected b/tests/golden/generic.expected index 5df244118..214d83a3c 100644 --- a/tests/golden/generic.expected +++ b/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) diff --git a/tests/golden/th.expected b/tests/golden/th.expected new file mode 100644 index 000000000..7909b7bb3 --- /dev/null +++ b/tests/golden/th.expected @@ -0,0 +1,48 @@ +OneConstructor +Error in $: When parsing the constructor OneConstructor of type Types.OneConstructor expected Array but got String. +Error in $: When parsing the constructor OneConstructor of type Types.OneConstructor expected an empty Array but got Array of length 1. +Nullary +Error in $: When parsing Types.Nullary expected a String with the tag of a constructor but got X. +Error in $: When parsing Types.Nullary expected String but got Array. +SomeType (tagged) +Error in $: parsing Int failed, expected Number, but encountered Boolean +Error in $: key "contents" not found +Error in $: When parsing the record record of type Types.SomeType the key testone was not present. +Error in $.testone: parsing Double failed, unexpected Boolean +Error in $: When parsing Types.SomeType expected an Object with a tag field where the value is one of [nullary, unary, product, record, list], but got X. +Error in $: key "tag" not found +Error in $: When parsing Types.SomeType expected Object but got Array. +SomeType (single-field) +Error in $: parsing Int failed, expected Number, but encountered Object +Error in $: parsing Int failed, expected Number, but encountered Array +Error in $: When parsing Types.SomeType expected an Object with a single tag/contents pair where the tag is one of [nullary, unary, product, record, list], but got X. +Error in $: When parsing Types.SomeType expected an Object with a single tag/contents pair but got 2 pairs. +Error in $: When parsing Types.SomeType expected an Object with a single tag/contents pair but got 0 pairs. +Error in $: When parsing Types.SomeType expected Object but got Array. +Error in $: not enough input. Expecting ':' +Error in $: not enough input. Expecting object value +Error in $: not enough input. Expecting ',' or '}' +SomeType (two-element array) +Error in $: parsing Int failed, expected Number, but encountered Boolean +Error in $: When parsing the constructor Record of type Types.SomeType expected Object but got Null. +Error in $: When parsing Types.SomeType expected a 2-element Array with a tag and contents element where the tag is one of [nullary, unary, product, record, list], but got X. +Error in $: When parsing Types.SomeType expected an Array of 2 elements where the first element is a String but got Null at the first element. +Error in $: When parsing Types.SomeType expected an Array of 2 elements but got 0 elements +Error in $: When parsing Types.SomeType expected Array but got Object. +Error in $: not enough input. Expecting ',' or ']' +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 $.testone: parsing Double failed, unexpected Boolean +Foo (reject unknown fields) +Error in $: Unknown fields: ["tag"] +Foo (reject unknown fields, tagged single) +Error in $: Unknown fields: ["unknownField"] +EitherTextInt +Error in $: When parsing the constructor NoneNullary of type Types.EitherTextInt expected String but got String. +Error in $: When parsing the constructor NoneNullary of type Types.EitherTextInt expected String but got Array. +Product2 Int Bool +Error in $: expected Bool, but encountered Null +Error in $: When parsing the constructor Product2 of type Types.Product2 expected Array of length 2 but got Array of length 0. +Error in $: When parsing the constructor Product2 of type Types.Product2 expected Array but got Object.